Changeset 303
- Timestamp:
- Mar 9, 2021, 9:19:49 AM (4 years ago)
- Location:
- branches/highdpi
- Files:
-
- 2 added
- 48 edited
- 2 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/AI/StdAI/AI.pas
r210 r303 6 6 7 7 uses 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 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; 12 11 13 12 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); 13 WaitAfterReject = 20; 14 // 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; 19 // minimum share of total production to specialize in military production 20 21 FutureTech = [futResearchTechnology, futProductionTechnology, 22 futArmorTechnology, futMissileTechnology]; 23 24 nResearchOrder = 46; 25 ResearchOrder: array[0..1, 0..nResearchOrder - 1] of integer = 26 ((adWheel, adWarriorCode, adHorsebackRiding, adCeremonialBurial, adPolytheism, 27 adMonarchy, adMysticism, adPoetry, adAstronomy, adMonotheism, 28 adTheology, adChivalry, adPottery, adMedicine, adGunpowder, adChemistry, 29 adExplosives, adUniversity, adTactics, adSeafaring, adNavigation, adRefining, 30 adCombustionEngine, 31 adAutomobile, adPhysics, adMagnetism, adElectricity, adRefrigeration, 32 adRadioCommunication, adTheoryOfGravity, adAtomicTheory, adElectronics, 33 adMassProduction, adPlastics, adFlight, adEnvironmentalism, 34 adSanitation, adMin, adComputers, adRecycling, adSyntheticFood, 35 adSelfContainedEnvironment, adNuclearFission, adNuclearPower, adTheLaser, 36 adIntelligenArms), 37 (adWheel, adWarriorCode, adHorsebackRiding, adAlphabet, adMapMaking, 38 adBronzeWorking, adWriting, 39 adCodeOfLaws, adCurrency, adTrade, adLiterature, adTheRepublic, adMathematics, 40 adPhilosophy, adScience, adMasonry, adConstruction, adEngineering, adInvention, 41 adIronWorking, adBridgeBuilding, adSteamEngine, adRailroad, adSteel, 42 adBanking, adIndustrialization, adConscription, adDemocracy, adEconomics, 43 adTheCorporation, adMassProduction, adRobotics, adCommunism, adMetallurgy, 44 adBallistics, adMobileWarfare, adAmphibiousWarfare, adMin, adComputers, 45 adRocketry, adAdvancedRocketry, 46 adAdvancedFlight, adSpaceFlight, adComposites, adIntelligence, adCombinedArms)); 47 48 LeaveOutTechs = [adPolytheism, adMysticism, adInvention, adEconomics, 49 adPottery, adMedicine, adEnvironmentalism, adRefining, adTrade, 50 adLiterature, adMathematics, adPhilosophy, adChemistry, adConscription, 51 adCombustionEngine, adPhysics, adTheoryOfGravity, adAtomicTheory, 52 adSyntheticFood, adNuclearFission]; 53 54 TechValue_ForResearch_LeaveOut = $700; 55 TechValue_ForResearch_Urgent = $600; 56 TechValue_ForResearch_Next = $400; 57 TechValue_ForResearch = $FF; 58 ForceNeeded_NoLeaveOut = 20; // advancedness behind to state-of-art 59 ForceNeeded_LeaveOut = 30; // advancedness behind of state-of-art 60 Compromise = 6; 61 62 // basic strategies 63 bGender = $0001; 64 bMale = $0000; 65 bFemale = $0001; 66 bBarbarina = $0006; 67 bBarbarina_Hide = $0002; 68 69 // model categories 70 nModelCat = 4; 71 mctNone = -1; 72 mctGroundDefender = 0; 73 mctGroundAttacker = 1; 74 mctTransport = 2; 75 mctCruiser = 3; 76 77 // mil research 78 BetterQuality: array[0..nModelCat - 1] of integer = (50, 50, 80, 80); 79 MaxBuildWorseThanBestModel = 20; 80 MaxExistWorseThanBestModel = 50; 81 82 maxCOD = 256; 83 PresenceUnknown = $10000; 84 85 nRequestedTechs = 48; 86 87 PlayerHash: array[0..nPl - 1] of integer = 88 (7, 6, 0, 2, 10, 8, 12, 14, 4, 1, 3, 5, 9, 11, 13); 78 89 79 90 type 80 Suggestion=(suContact, suPeace, suFriendly);81 82 TPersistentData=record83 LastResearchTech, BehaviorFlags, TheologyPartner: integer;84 RejectTurn: array[Suggestion,0..15] of smallint;85 RequestedTechs: array[0..nRequestedTechs-1] of integer;91 Suggestion = (suContact, suPeace, suFriendly); 92 93 TPersistentData = record 94 LastResearchTech, BehaviorFlags, TheologyPartner: integer; 95 RejectTurn: array[Suggestion, 0..15] of smallint; 96 RequestedTechs: array[0..nRequestedTechs - 1] of integer; 86 97 // ad + p shl 8 + Turn shl 16 87 98 end; 88 99 89 TAI = class(TBarbarina)90 constructor Create(Nation: integer); override;91 92 procedure SetDataDefaults; override;93 94 protected95 Data: ^TPersistentData;96 WarNations, BombardingNations, mixSettlers, mixCaravan, mixTownGuard,100 TAI = class(TBarbarina) 101 constructor Create(Nation: integer); override; 102 103 procedure SetDataDefaults; override; 104 105 protected 106 Data: ^TPersistentData; 107 WarNations, BombardingNations, mixSettlers, mixCaravan, mixTownGuard, 97 108 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;109 NegoCause: (Routine, CheckBarbarina); 110 SettlerSurplus: array[0..maxCOD - 1] of integer; 111 uixPatrol: array[0..maxCOD - 1] of integer; 112 113 ContinentPresence: array[0..maxCOD - 1] of integer; 114 OceanPresence: array[0..maxCOD - 1] of integer; 115 UnitLack: array[0..maxCOD - 1, mctGroundDefender..mctGroundAttacker] of integer; 116 117 TotalPopulation: array[0..nPl - 1] of integer; 118 ContinentPopulation: array[0..nPl - 1, 0..maxCOD - 1] of integer; 108 119 // 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;120 DistrictPopulation: array[0..maxCOD - 1] of integer; 121 122 ModelCat: array[0..nMmax - 1] of integer; 123 ModelQuality: array[0..nMmax - 1] of integer; 124 ModelBestQuality: array[0..nModelCat - 1] of integer; 125 126 AdvanceValue: array[0..nAdv - 1] of integer; 127 AdvanceValuesSet: boolean; 128 129 procedure DoTurn; override; 130 procedure DoNegotiation; override; 131 function ChooseResearchAdvance: integer; override; 132 function ChooseStealAdvance: integer; override; 133 function ChooseGovernment: integer; override; 134 function WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; override; 135 function OnNegoRejected_CancelTreaty: boolean; override; 136 137 procedure FindBestTrade(Nation: integer; var adWanted, adGiveAway: integer); 138 procedure CheckGender; 139 procedure AnalyzeMap; 140 procedure CollectModelCatStat; 141 procedure AttackAndPatrol; 142 procedure MoveUnitsHome; 143 procedure CheckAttack(uix: integer); 144 procedure Patrol(uix: integer); 145 procedure SetCityProduction; 146 procedure SetAdvanceValues; 147 function HavePort: boolean; 137 148 {$IFDEF DEBUG}procedure TraceAdvanceValues(Nation: integer);{$ENDIF} 138 149 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; 150 // research 151 procedure RateModel(const mi: TModelInfo; var Category, Quality: integer); 152 procedure RateMyModel(mix: integer; var Category, Quality: integer); 153 function IsBetterModel(const mi: TModelInfo): boolean; 154 155 //terraforming 156 procedure TileWorkPlan(Loc, cix: integer; var Value, NextJob, TotalWork: integer); 157 procedure ProcessSettlers; 158 159 // diplomacy 160 function MostWanted(Nation, adGiveAway: integer): integer; 151 161 152 162 end; … … 156 166 157 167 uses 158 Pile;168 Pile; 159 169 160 170 const 161 // fine adjustment162 Aggressive=40; // 0 = never attacks, 100 = attacks even with heavy losses163 DestroyBonus=30; // percent of building cost171 // fine adjustment 172 Aggressive = 40; // 0 = never attacks, 100 = attacks even with heavy losses 173 DestroyBonus = 30; // percent of building cost 164 174 165 175 var 166 LeaveOutValue: array[0..nAdv-1] of integer;176 LeaveOutValue: array[0..nAdv - 1] of integer; 167 177 168 178 169 179 constructor TAI.Create(Nation: integer); 170 180 begin 171 inherited; 172 Data:=pointer(RO.Data); 173 {$IFDEF DEBUG}if Nation=1 then SetDebugMap(DebugMap);{$ENDIF} 174 AdvanceValuesSet:=false; 181 inherited; 182 Data := pointer(RO.Data); 183 {$IFDEF DEBUG} 184 if Nation = 1 then 185 SetDebugMap(DebugMap); 186 {$ENDIF} 187 AdvanceValuesSet := False; 175 188 end; 176 189 177 190 procedure TAI.SetDataDefaults; 178 191 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 192 with Data^ do 193 begin 194 LastResearchTech := -1; 195 if PlayerHash[me] > 7 then 196 BehaviorFlags := bFemale 197 else 198 BehaviorFlags := bMale; 199 DebugMessage(1, 'Gender:=' + char(48 + BehaviorFlags and bGender)); 200 TheologyPartner := -1; 201 fillchar(RejectTurn, sizeof(RejectTurn), $FF); 202 Fillchar(RequestedTechs, sizeof(RequestedTechs), $FF); 203 end; 188 204 end; 189 205 190 206 function TAI.OnNegoRejected_CancelTreaty: boolean; 191 207 begin 192 Data.RejectTurn[suContact,Opponent]:=RO.Turn;193 result:= Data.BehaviorFlags and bBarbarina<>0;208 Data.RejectTurn[suContact, Opponent] := RO.Turn; 209 Result := Data.BehaviorFlags and bBarbarina <> 0; 194 210 end; 195 211 … … 201 217 procedure TAI.RateModel(const mi: TModelInfo; var Category, Quality: integer); 202 218 var 203 EffectiveTransport: integer;219 EffectiveTransport: integer; 204 220 begin 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 221 if mi.Kind >= mkScout then 222 begin 223 Category := mctNone; 224 exit; 225 end; 226 case mi.Domain of 227 dGround: 228 if mi.Speed >= 250 then 229 begin 230 Category := mctGroundAttacker; 231 if mi.Attack = 0 then 232 Quality := 0 233 else 234 begin 235 Quality := trunc(100 * (ln(mi.Attack) + ln(mi.Defense) + 236 ln(mi.Speed / 150) * 1.7 - ln(mi.Cost))); 237 if mi.Cap and (1 shl (mcFanatic - mcFirstNonCap)) <> 0 then 238 Inc(Quality, trunc(100 * ln(1.5))); 239 if mi.Cap and (1 shl (mcLongRange - mcFirstNonCap)) <> 0 then 240 Inc(Quality, trunc(100 * ln(1.5))); 241 end; 242 end 213 243 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 244 begin 245 Category := mctGroundDefender; 246 Quality := trunc(100 * (ln(mi.Defense) - ln(mi.Cost) * 0.6)); 247 if mi.Cap and (1 shl (mcFanatic - mcFirstNonCap)) <> 0 then 248 Inc(Quality, trunc(100 * ln(1.5))); 249 end; 250 dSea: 251 if mi.Attack = 0 then 252 begin 253 Category := mctTransport; 254 if mi.TTrans = 0 then 255 Quality := 0 256 else 257 begin 258 EffectiveTransport := mi.TTrans; 259 if EffectiveTransport > 4 then 260 EffectiveTransport := 4; // rarely used more 261 Quality := 100 + trunc(100 * (ln(EffectiveTransport) + 262 ln(mi.Speed / 150) + ln(mi.Defense) - ln(mi.Cost))); 263 if mi.Cap and (1 shl (mcNav - mcFirstNonCap)) <> 0 then 264 Inc(Quality, trunc(100 * ln(1.5))); 265 if mi.Cap and (1 shl (mcAirDef - mcFirstNonCap)) <> 0 then 266 Inc(Quality, trunc(100 * ln(1.3))); 267 end; 221 268 end 222 else223 begin224 Category:=mctGroundDefender;225 Quality:=trunc(100*(ln(mi.Defense)-ln(mi.Cost)*0.6));226 if mi.Cap and (1 shl (mcFanatic-mcFirstNonCap))<>0 then227 inc(Quality,trunc(100*ln(1.5)));228 end;229 dSea:230 if mi.Attack=0 then231 begin232 Category:=mctTransport;233 if mi.TTrans=0 then Quality:=0234 269 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); 270 begin 271 Category := mctCruiser; 272 if mi.Attack = 0 then 273 Quality := 0 274 else 275 begin 276 Quality := trunc(100 * (ln(mi.Attack) + ln(mi.Defense) * 0.6 - ln(mi.Cost))); 277 if mi.Cap and (1 shl (mcNav - mcFirstNonCap)) <> 0 then 278 Inc(Quality, trunc(100 * ln(1.4))); 279 if mi.Cap and (1 shl (mcAirDef - mcFirstNonCap)) <> 0 then 280 Inc(Quality, trunc(100 * ln(1.3))); 281 if mi.Cap and (1 shl (mcLongRange - mcFirstNonCap)) <> 0 then 282 Inc(Quality, trunc(100 * ln(2.0))); 283 if mi.Cap and (1 shl (mcRadar - mcFirstNonCap)) <> 0 then 284 Inc(Quality, trunc(100 * ln(1.5))); 285 end; 286 end; 287 dAir: 288 begin 289 Category := mctNone; 290 Quality := 0; 291 end; 292 end; 293 //!!!assert(Quality>0); 269 294 end; 270 295 271 296 procedure TAI.RateMyModel(mix: integer; var Category, Quality: integer); 272 297 var 273 mi: TModelInfo;298 mi: TModelInfo; 274 299 begin 275 MakeModelInfo(me,mix,MyModel[mix],mi);276 RateModel(mi,Category,Quality);300 MakeModelInfo(me, mix, MyModel[mix], mi); 301 RateModel(mi, Category, Quality); 277 302 end; 278 303 279 304 function TAI.IsBetterModel(const mi: TModelInfo): boolean; 280 305 var 281 mix,Cat,Quality,Cat1,Quality1: integer;306 mix, Cat, Quality, Cat1, Quality1: integer; 282 307 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; 308 RateModel(mi, Cat, Quality); 309 for mix := 0 to RO.nModel - 1 do 310 if mi.Domain = MyModel[mix].Domain then 311 begin 312 RateMyModel(mix, Cat1, Quality1); 313 if (Cat = Cat1) and (Quality < Quality1 + BetterQuality[Cat]) then 314 begin 315 Result := False; 316 exit; 317 end; 318 end; 319 Result := True; 291 320 end; 292 321 293 322 function TAI.ChooseResearchAdvance: integer; 294 323 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;324 adNext, iad, i, ad, Count, EarliestNeeded, EarliestNeeded_NoLeaveOut, 325 NewResearch, StateOfArt, mix: integer; 326 mi: TModelInfo; 327 Entry: array[0..nAdv - 1] of boolean; 328 ok: boolean; 300 329 301 330 function MarkEntry(ad: integer): boolean; 302 331 begin 303 if RO.Tech[ad]>=tsApplicable then304 result:=false // nothing more to research here305 else if RO.Tech[ad]=tsSeen then306 begin 307 Entry[ad]:=true;308 result:=true332 if RO.Tech[ad] >= tsApplicable then 333 Result := False // nothing more to research here 334 else if RO.Tech[ad] = tsSeen then 335 begin 336 Entry[ad] := True; 337 Result := True; 309 338 end 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; 339 else 340 begin 341 Entry[ad] := True; 342 if ad = adScience then 343 begin 344 if MarkEntry(adTheology) then 345 Entry[ad] := False; 346 if MarkEntry(adPhilosophy) then 347 Entry[ad] := False; 317 348 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 349 else if ad = adMassProduction then 350 begin 351 if MarkEntry(adAutomobile) then 352 Entry[ad] := False; 353 if Data.BehaviorFlags and bGender = bMale then 354 begin 355 if MarkEntry(adElectronics) then 356 Entry[ad] := False; 357 end 358 else 359 begin 360 if MarkEntry(adTheCorporation) then 361 Entry[ad] := False; 362 end; 324 363 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 364 else 365 begin 366 if AdvPreq[ad, 0] >= 0 then 367 if MarkEntry(AdvPreq[ad, 0]) then 368 Entry[ad] := False; 369 if AdvPreq[ad, 1] >= 0 then 370 if MarkEntry(AdvPreq[ad, 1]) then 371 Entry[ad] := False; 372 end; 373 Result := True; 374 end; 334 375 end; 335 376 336 377 procedure OptimizeDevModel(OptimizeCaps: integer); 337 378 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 repeat344 Best:=-1;345 for f:=0 to nFeature-1 do346 if (1 shl f and OptimizeCaps<>0)347 and ((Feature[f].Preq<0) or IsResearched(Feature[f].Preq)) // check prerequisite348 and (RO.DevModel.Weight+Feature[f].Weight<=RO.DevModel.MaxWeight)349 and not((f>=mcFirstNonCap) and (RO.DevModel.Cap[f]>0)) then350 begin 351 if SetNewModelFeature(f,RO.DevModel.Cap[f]+1)>=rExecuted then379 f, Cat, OriginalCat, Quality, BestQuality, Best: integer; 380 mi: TModelInfo; 381 begin 382 MakeModelInfo(me, 0, RO.DevModel, mi); 383 RateModel(mi, OriginalCat, BestQuality); 384 repeat 385 Best := -1; 386 for f := 0 to nFeature - 1 do 387 if (1 shl f and OptimizeCaps <> 0) and 388 ((Feature[f].Preq < 0) or IsResearched(Feature[f].Preq)) // check prerequisite 389 and (RO.DevModel.Weight + Feature[f].Weight <= RO.DevModel.MaxWeight) and 390 not ((f >= mcFirstNonCap) and (RO.DevModel.Cap[f] > 0)) then 391 begin 392 if SetNewModelFeature(f, RO.DevModel.Cap[f] + 1) >= rExecuted then 352 393 begin 353 MakeModelInfo(me,0,RO.DevModel,mi);354 RateModel(mi,Cat,Quality);355 assert(Cat=OriginalCat);356 if Quality>BestQuality then394 MakeModelInfo(me, 0, RO.DevModel, mi); 395 RateModel(mi, Cat, Quality); 396 assert(Cat = OriginalCat); 397 if Quality > BestQuality then 357 398 begin 358 Best:=f;359 BestQuality:=Quality;399 Best := f; 400 BestQuality := Quality; 360 401 end; 361 SetNewModelFeature(f,RO.DevModel.Cap[f]-1)362 end 363 end; 364 if Best>=0 then365 SetNewModelFeature(Best,RO.DevModel.Cap[Best]+1)366 until Best<0402 SetNewModelFeature(f, RO.DevModel.Cap[f] - 1); 403 end; 404 end; 405 if Best >= 0 then 406 SetNewModelFeature(Best, RO.DevModel.Cap[Best] + 1) 407 until Best < 0; 367 408 end; 368 409 369 410 function LeaveOutsMissing(ad: integer): boolean; 370 411 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); 412 i: integer; 413 begin 414 Result := False; 415 if RO.Tech[ad] < tsSeen then 416 if ad in LeaveOutTechs then 417 Result := True 418 else if ad = adScience then 419 begin 420 Result := Result or LeaveOutsMissing(adTheology); 421 Result := Result or LeaveOutsMissing(adPhilosophy); 380 422 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]); 423 else if ad = adMassProduction then 424 Result := True 425 else 426 for i := 0 to 1 do 427 if AdvPreq[ad, i] >= 0 then 428 Result := Result or LeaveOutsMissing(AdvPreq[ad, i]); 386 429 end; 387 430 388 431 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 432 if Data.BehaviorFlags and bBarbarina <> 0 then 433 begin 434 Result := Barbarina_ChooseResearchAdvance; 435 if Result >= 0 then 436 exit; 437 end; 438 439 SetAdvanceValues; 440 441 // always complete traded techs first 442 Result := -1; 443 for ad := 0 to nAdv - 1 do 444 if (RO.Tech[ad] = tsSeen) and ((Result < 0) or 445 (AdvanceValue[ad] > AdvanceValue[Result])) then 446 Result := ad; 447 if Result >= 0 then 448 exit; 449 450 if Data.BehaviorFlags and bBarbarina = 0 then 451 begin 452 // develop new model? 453 if IsResearched(adWarriorCode) and IsResearched(adHorsebackRiding) and 454 not ((Data.BehaviorFlags and bGender = bMale) and 455 (RO.Tech[adIronWorking] >= tsApplicable) // wait for gunpowder 456 and (RO.Tech[adGunPowder] < tsApplicable)) then 411 457 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 458 PrepareNewModel(dGround); 459 SetNewModelFeature(mcDefense, 1); 460 SetNewModelFeature(mcOffense, 2); 461 SetNewModelFeature(mcMob, 2); 462 OptimizeDevModel(1 shl mcOffense + 1 shl mcDefense + 1 shl 463 mcMob + 1 shl mcLongRange + 1 shl mcFanatic); 464 MakeModelInfo(me, 0, RO.DevModel, mi); 465 if IsBetterModel(mi) then 466 begin 467 Result := adMilitary; 468 exit; 469 end; 470 471 PrepareNewModel(dGround); 472 SetNewModelFeature(mcDefense, 2); 473 SetNewModelFeature(mcOffense, 1); 474 OptimizeDevModel(1 shl mcOffense + 1 shl mcDefense + 1 shl mcFanatic); 475 MakeModelInfo(me, 0, RO.DevModel, mi); 476 if IsBetterModel(mi) then 477 begin 478 Result := adMilitary; 479 exit; 480 end; 481 end; 482 483 if IsResearched(adMapMaking) and IsResearched(adSeafaring) and 484 IsResearched(adNavigation) and IsResearched(adSteamEngine) then 485 begin 486 Result := adMilitary; 487 for mix := 0 to RO.nModel - 1 do 488 if MyModel[mix].Cap[mcNav] > 0 then 489 Result := -1; 490 if Result = adMilitary then 491 begin 492 PrepareNewModel(dSea); 493 SetNewModelFeature(mcWeapons, 0); 494 SetNewModelFeature(mcDefense, 3); 495 exit; 496 end; 443 497 end; 444 498 … … 475 529 end; 476 530 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 531 NewResearch := -1; 532 533 // check if cooperation with other gender doesn't work -- go for old needed techs then 534 StateOfArt := -1; 535 for ad := 0 to nAdv - 1 do 536 if (RO.Tech[ad] >= tsApplicable) and (Advancedness[ad] > StateOfArt) then 537 StateOfArt := Advancedness[ad]; 538 EarliestNeeded := -1; 539 EarliestNeeded_NoLeaveOut := -1; 540 for ad := 0 to nAdv - 1 do 541 if (RO.Tech[ad] < tsSeen) and (AdvanceValue[ad] >= $100) and 542 ((EarliestNeeded < 0) or (Advancedness[ad] < Advancedness[EarliestNeeded])) then 543 begin 544 ok := False; 545 for iad := 0 to nResearchOrder - 1 do 546 if ResearchOrder[Data.BehaviorFlags and bGender, iad] = ad then 547 begin 548 ok := True; 549 break; 550 end; 551 if not ok then 552 begin 553 EarliestNeeded := ad; 554 if not LeaveOutsMissing(ad) then 555 EarliestNeeded_NoLeaveOut := ad; 556 end; 557 end; 558 if EarliestNeeded >= 0 then 559 begin 560 if (EarliestNeeded_NoLeaveOut >= 0) and 561 (Advancedness[EarliestNeeded_NoLeaveOut] + ForceNeeded_NoLeaveOut < 562 StateOfArt) then 563 begin 564 {$IFDEF DEBUG} 565 DebugMessage(2, 'No partner found, go for ' + 566 Name_Advance[EarliestNeeded_NoLeaveOut]); 567 {$ENDIF} 568 NewResearch := EarliestNeeded_NoLeaveOut; 510 569 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 570 else if Advancedness[EarliestNeeded] + ForceNeeded_LeaveOut < StateOfArt then 571 begin 572 {$IFDEF DEBUG} 573 DebugMessage(2, 'No partner found, go for ' + Name_Advance[EarliestNeeded]); 574 {$ENDIF} 575 NewResearch := EarliestNeeded; 576 end; 577 end; 578 579 // choose first directly researchable advance from own branch 580 adNext := -1; 581 if NewResearch < 0 then 582 for iad := 0 to nResearchOrder - 1 do 583 begin 584 ad := ResearchOrder[Data.BehaviorFlags and bGender, iad]; 585 if RO.Tech[ad] < tsApplicable then 586 begin 587 if adNext < 0 then 588 adNext := ad; 589 if AdvPreq[ad, 2] <> preNone then 529 590 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 591 Count := 0; 592 for i := 0 to 2 do 593 if RO.Tech[AdvPreq[ad, i]] >= tsApplicable then 594 Inc(Count); 595 if Count >= 2 then 596 begin 597 Result := ad; 598 exit; 599 end; 535 600 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 601 else if ((AdvPreq[ad, 0] = preNone) or 602 (RO.Tech[AdvPreq[ad, 0]] >= tsApplicable)) and 603 ((AdvPreq[ad, 1] = preNone) or (RO.Tech[AdvPreq[ad, 1]] >= tsApplicable)) then 604 begin 605 Result := ad; 606 exit; 607 end; 608 end; 609 end; 610 611 if NewResearch < 0 then 612 if adNext >= 0 then 613 NewResearch := adNext // need tech from other gender 614 else if EarliestNeeded_NoLeaveOut >= 0 then 615 NewResearch := EarliestNeeded_NoLeaveOut 616 // own branch complete, pick tech from other gender 617 else if EarliestNeeded >= 0 then 618 NewResearch := EarliestNeeded // own branch complete, pick tech from other gender 619 else 550 620 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); 621 Result := -1; 622 i := 0; 623 for ad := nAdv - 4 to nAdv - 1 do 624 if (RO.Tech[ad] < MaxFutureTech) and (RO.Tech[AdvPreq[ad, 0]] >= 625 tsApplicable) then 626 begin 627 Inc(i); 628 if random(i) = 0 then 629 Result := ad; 630 end; 631 assert((Result < 0) or AdvanceResearchable(Result)); 632 exit; 633 end; 634 635 assert(NewResearch >= 0); 636 fillchar(Entry, sizeof(Entry), False); 637 MarkEntry(NewResearch); 638 Result := -1; 639 for ad := 0 to nAdv - 1 do 640 if Entry[ad] and ((Result < 0) or (Advancedness[ad] > Advancedness[Result])) then 641 Result := ad; 642 assert(Result >= 0); 572 643 end; 573 644 574 645 function TAI.ChooseStealAdvance: integer; 575 646 var 576 ad: integer;647 ad: integer; 577 648 begin 578 result:=-1;579 for ad:=0 to nAdv-1 do580 if AdvanceStealable(ad)581 and ((result<0) or (Advancedness[ad]>Advancedness[result])) then582 result:=ad649 Result := -1; 650 for ad := 0 to nAdv - 1 do 651 if AdvanceStealable(ad) and 652 ((Result < 0) or (Advancedness[ad] > Advancedness[Result])) then 653 Result := ad; 583 654 end; 584 655 … … 589 660 590 661 const 591 twpAllowFarmland=$0001; 592 593 procedure TAI.TileWorkPlan(Loc, cix: integer; 594 var Value, NextJob, TotalWork: integer); 662 twpAllowFarmland = $0001; 663 664 procedure TAI.TileWorkPlan(Loc, cix: integer; var Value, NextJob, TotalWork: integer); 595 665 var 596 OldTile,TerrType: Cardinal;597 TileInfo: TTileInfo;666 OldTile, TerrType: cardinal; 667 TileInfo: TTileInfo; 598 668 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 669 TotalWork := 0; 670 NextJob := jNone; 671 if Map[Loc] and (fRare1 or fRare2) <> 0 then 672 begin 673 Value := 3 * 8 - 1; 674 exit; 675 end; // better than any tile with 2 food 676 677 OldTile := Map[Loc]; 678 TerrType := Map[Loc] and fTerrain; 679 if (TerrType >= fGrass) then 680 begin 681 if Map[Loc] and fPoll <> 0 then 609 682 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 683 if NextJob = jNone then 684 NextJob := jPoll; 685 Inc(TotalWork, PollWork); 686 Map[Loc] := Map[Loc] and not fPoll; 687 end; 688 if Map[Loc] and (fTerrain or fSpecial) = fSwamp then 615 689 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] or621 Cardinal(SpecialTile(Loc,TerrType,G.lx) shl 5);690 if NextJob = jNone then 691 NextJob := jClear; 692 Inc(TotalWork, Terrain[TerrType].IrrClearWork); 693 Map[Loc] := Map[Loc] and not fTerrain or fGrass; 694 TerrType := fGrass; 695 Map[Loc] := Map[Loc] or cardinal(SpecialTile(Loc, TerrType, G.lx) shl 5); 622 696 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 697 else if IsResearched(adExplosives) and 698 (Map[Loc] and (fTerrain or fSpecial) in [fTundra, fHills]) and 699 (Map[Loc] and fTerImp <> tiMine) and (SpecialTile(Loc, fHills, G.lx) = 0) then 627 700 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] or633 Cardinal(SpecialTile(Loc,TerrType,G.lx) shl 5);634 end; 635 if (Terrain[TerrType].MineEff>0) and (RO.Government<>gDespotism) then636 begin 637 if Map[Loc] and fTerImp<>tiMine then701 if NextJob = jNone then 702 NextJob := jTrans; 703 Inc(TotalWork, Terrain[TerrType].TransWork); 704 Map[Loc] := Map[Loc] and not fTerrain or fGrass; 705 TerrType := fGrass; 706 Map[Loc] := Map[Loc] or cardinal(SpecialTile(Loc, TerrType, G.lx) shl 5); 707 end; 708 if (Terrain[TerrType].MineEff > 0) and (RO.Government <> gDespotism) then 709 begin 710 if Map[Loc] and fTerImp <> tiMine then 638 711 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; 712 if NextJob = jNone then 713 NextJob := jMine; 714 Inc(TotalWork, Terrain[TerrType].MineAfforestWork); 715 Map[Loc] := Map[Loc] and not fTerImp or tiMine; 716 end; 717 end 718 else if Terrain[TerrType].IrrEff > 0 then 719 begin 720 if Map[Loc] and fTerImp = tiIrrigation then 721 begin // add farmland 722 if (MyCity[cix].Built[imSupermarket] > 0) and 723 IsResearched(adRefrigeration) and (RO.Government <> gDespotism) then 724 begin 725 if NextJob = jNone then 726 NextJob := jFarm; 727 Inc(TotalWork, Terrain[TerrType].IrrClearWork * FarmWork); 728 Map[Loc] := Map[Loc] and not fTerImp or tiFarm; 729 end; 642 730 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 731 else if Map[Loc] and fTerImp <> tiFarm then 657 732 begin // add irrigation 658 if (RO.Government<>gDespotism)659 or (Map[Loc] and (fTerrain or fSpecial)<>fGrass) then660 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 end665 end666 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)) then733 if (RO.Government <> gDespotism) or 734 (Map[Loc] and (fTerrain or fSpecial) <> fGrass) then 735 begin 736 if NextJob = jNone then 737 NextJob := jIrr; 738 Inc(TotalWork, Terrain[TerrType].IrrClearWork); 739 Map[Loc] := Map[Loc] and not fTerImp or tiIrrigation; 740 end; 741 end; 742 end; 743 if (Terrain[TerrType].MoveCost = 1) and (Map[Loc] and (fRoad or fRR) = 0) and 744 ((Map[Loc] and fRiver = 0) or IsResearched(adBridgeBuilding)) then 670 745 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) then746 if NextJob = jNone then 747 NextJob := jRoad; 748 Inc(TotalWork, RoadWork); 749 Map[Loc] := Map[Loc] or fRoad; 750 end; 751 if ((Map[Loc] and fTerImp = tiMine) or 752 (Terrain[TerrType].ProdRes[Map[Loc] shr 5 and 3] >= 2)) and 753 IsResearched(adRailroad) and (Map[Loc] and fRR = 0) and 754 ((Map[Loc] and fRiver = 0) or IsResearched(adBridgeBuilding)) and 755 (RO.Government <> gDespotism) then 681 756 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; 757 if Map[Loc] and fRoad = 0 then 758 begin 759 if NextJob = jNone then 760 NextJob := jRoad; 761 Inc(TotalWork, RoadWork * Terrain[TerrType].MoveCost); 762 end; 763 if NextJob = jNone then 764 NextJob := jRR; 765 Inc(TotalWork, RRWork * Terrain[TerrType].MoveCost); 766 Map[Loc] := Map[Loc] and not fRoad or fRR; 767 end; 768 end; 769 Server(sGetTileInfo, me, Loc, TileInfo); 770 Value := TileInfo.Food * 8 + TileInfo.Prod * 2 + TileInfo.Trade; 771 Map[Loc] := OldTile; 695 772 end; 696 773 … … 698 775 procedure TAI.ProcessSettlers; 699 776 var 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);777 i, uix, cix, ecix, dtr, Loc, RadiusLoc, Special, Food, Prod, Trade, 778 CityFood, Happy, TestScore, BestNearCityScore, BestUnusedValue, 779 BestUnusedLoc, Value, NextJob, TotalWork, V21, part, Loc1: integer; 780 Tile: cardinal; 781 FoodOk, Started: boolean; 782 Radius: TVicinity21Loc; 783 CityAreaInfo: TCityAreaInfo; 784 TileFood, ResourceScore, CityScore: array[0..lxmax * lymax - 1] of integer; 785 786 procedure AddJob(Loc, Job, Score: integer); 710 787 // set Score=1 for low-priority jobs 711 788 begin 712 JobAssignment_AddJob(Loc,Job,Score);713 if (Score>1) and (District[Loc]>=0) and (District[Loc]<maxCOD) then714 dec(SettlerSurplus[District[Loc]]);789 JobAssignment_AddJob(Loc, Job, Score); 790 if (Score > 1) and (District[Loc] >= 0) and (District[Loc] < maxCOD) then 791 Dec(SettlerSurplus[District[Loc]]); 715 792 end; 716 793 717 794 procedure ReserveCityRadius(Loc: integer); 718 795 var 719 V21,RadiusLoc: integer;720 Radius: TVicinity21Loc;721 begin 722 V21_to_Loc(Loc,Radius);723 for V21:=1 to 26 do724 begin 725 RadiusLoc:=Radius[V21];726 if (RadiusLoc>=0) then727 begin 728 ResourceScore[RadiusLoc]:=0;729 TileFood[RadiusLoc]:=0;730 end 731 end 796 V21, RadiusLoc: integer; 797 Radius: TVicinity21Loc; 798 begin 799 V21_to_Loc(Loc, Radius); 800 for V21 := 1 to 26 do 801 begin 802 RadiusLoc := Radius[V21]; 803 if (RadiusLoc >= 0) then 804 begin 805 ResourceScore[RadiusLoc] := 0; 806 TileFood[RadiusLoc] := 0; 807 end; 808 end; 732 809 end; 733 810 734 811 procedure ScoreRoadConnections; 735 812 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 813 V8, nFragments, Loc, Loc1, History, RoadScore, a, b, FullyDeveloped, 814 ConnectMask: integer; 815 BridgeOk: boolean; 816 Adjacent: TVicinity8Loc; 817 begin 818 BridgeOk := IsResearched(adBridgeBuilding); 819 if IsResearched(adRailroad) then 820 FullyDeveloped := fRR or fCity 821 else 822 FullyDeveloped := fRoad or fRR or fCity; 823 for Loc := G.lx to G.lx * (G.ly - 1) - 1 do 824 if ((1 shl (Map[Loc] and fTerrain)) and (1 shl fOcean or 1 shl 825 fShore or 1 shl fDesert or 1 shl fArctic or 1 shl fUNKNOWN) = 0) and 826 (RO.Territory[Loc] = me) and (Map[Loc] and FullyDeveloped = 0) and 827 (BridgeOk or (Map[Loc] and fRiver = 0)) then 828 begin 829 nFragments := 0; 830 History := 0; 831 if Map[Loc] and fRoad <> 0 then 832 ConnectMask := fRR or fCity // check for railroad 833 else 834 ConnectMask := fRoad or fRR or fCity; // check for road 835 V8_to_Loc(Loc, Adjacent); 836 for V8 := 0 to 9 do 837 begin 838 Loc1 := Adjacent[V8 and 7]; 839 History := History shl 1; 840 if (Loc1 >= 0) and (RO.Territory[Loc1] = me) and 841 (Map[Loc1] and ConnectMask <> 0) then 760 842 begin 761 inc(History);762 if V8>=2 then843 Inc(History); 844 if V8 >= 2 then 763 845 begin 764 inc(nFragments);765 case V8 and 1 of766 0:767 if History and 6<>0 then768 dec(nFragments);769 1:770 if History and 2<>0 then771 dec(nFragments)772 else if History and 4<>0 then846 Inc(nFragments); 847 case V8 and 1 of 848 0: 849 if History and 6 <> 0 then 850 Dec(nFragments); 851 1: 852 if History and 2 <> 0 then 853 Dec(nFragments) 854 else if History and 4 <> 0 then 773 855 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) 856 V8_to_ab((V8 - 1) and 7, a, b); 857 ab_to_Loc(Loc, a shl 1, b shl 1, Loc1); 858 if (Loc1 >= 0) and (Map[Loc1] and ConnectMask <> 0) then 859 Dec(nFragments); 779 860 end 780 end 861 end; 781 862 end; 782 863 end; 783 864 end; 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) 865 if nFragments >= 2 then // road or railroad connection desirable 866 begin 867 if Map[Loc] and fRiver <> 0 then 868 RoadScore := 44 + (nFragments - 2) * 4 869 else 870 RoadScore := 56 - Terrain[Map[Loc] and fTerrain].MoveCost * 4 + 871 (nFragments - 2) * 4; 872 if Map[Loc] and fRoad <> 0 then 873 AddJob(Loc, jRR, RoadScore) 874 else 875 AddJob(Loc, jRoad, RoadScore); 792 876 end; 793 877 end; … … 795 879 796 880 begin 797 fillchar(SettlerSurplus, sizeof(SettlerSurplus), 0);798 JobAssignment_Initialize;799 800 if (Data.BehaviorFlags and bBarbarina=0) or (RO.nCity<3) then801 begin 802 fillchar(TileFood,sizeof(TileFood),0);803 fillchar(ResourceScore,sizeof(ResourceScore),0);804 for Loc:=0 to MapSize-1 do805 if Map[Loc] and fTerrain<>fUNKNOWN then806 if Map[Loc] and fDeadLands<>0 then807 begin 808 if not IsResearched(adMassProduction) or (Map[Loc] and fModern<>0) then809 ResourceScore[Loc]:=20;881 fillchar(SettlerSurplus, sizeof(SettlerSurplus), 0); 882 JobAssignment_Initialize; 883 884 if (Data.BehaviorFlags and bBarbarina = 0) or (RO.nCity < 3) then 885 begin 886 fillchar(TileFood, sizeof(TileFood), 0); 887 fillchar(ResourceScore, sizeof(ResourceScore), 0); 888 for Loc := 0 to MapSize - 1 do 889 if Map[Loc] and fTerrain <> fUNKNOWN then 890 if Map[Loc] and fDeadLands <> 0 then 891 begin 892 if not IsResearched(adMassProduction) or (Map[Loc] and fModern <> 0) then 893 ResourceScore[Loc] := 20; 810 894 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 895 else if Map[Loc] and fTerrain = fGrass then 896 TileFood[Loc] := Terrain[fGrass].FoodRes[Map[Loc] shr 5 and 3] - 1 897 else 898 begin 899 Special := SpecialTile(Loc, Map[Loc] and fTerrain, G.lx); 900 if Special <> 0 then 901 with Terrain[Map[Loc] and fTerrain] do 902 begin 903 Food := FoodRes[Special]; 904 if MineEff = 0 then 905 Inc(Food, IrrEff); 906 Prod := ProdRes[Special] + MineEff; 907 Trade := TradeRes[Special]; 908 if MoveCost = 1 then 909 Inc(Trade); 910 ResourceScore[Loc] := Food + 2 * Prod + Trade - 7; 911 if Food > 2 then 912 TileFood[Loc] := Food - 2; 913 end; 914 end; 915 916 for cix := 0 to RO.nCity - 1 do 917 if MyCity[cix].Loc >= 0 then 918 ReserveCityRadius(MyCity[cix].Loc); // these resources already have a city 919 for uix := 0 to RO.nUn - 1 do 920 if (MyUnit[uix].Loc >= 0) and (MyUnit[uix].Job = jCity) then 921 ReserveCityRadius(MyUnit[uix].Loc); // these resources almost already have a city 922 for ecix := 0 to RO.nEnemyCity - 1 do 923 if RO.EnemyCity[ecix].Loc >= 0 then 924 ReserveCityRadius(RO.EnemyCity[ecix].Loc); 925 // these resources already have an enemy city 926 927 // rate possible new cities 928 fillchar(CityScore, MapSize * sizeof(integer), 0); 929 for Loc := 0 to MapSize - 1 do 930 begin 931 FoodOk := (TileFood[Loc] > 0) and 932 ((Map[Loc] and fTerrain = fGrass) and 933 ((RO.Government <> gDespotism) or (Map[Loc] and fSpecial = fSpecial1)) or 934 (Map[Loc] and (fTerrain or fSpecial) = fPrairie or fSpecial1)); 935 if FoodOk and ((RO.Territory[Loc] < 0) or (RO.Territory[Loc] = me)) then 936 begin 937 TestScore := 0; 938 CityFood := 0; 939 BestNearCityScore := 0; 940 V21_to_Loc(Loc, Radius); 941 for V21 := 1 to 26 do 942 begin // sum resource scores in potential city radius 943 RadiusLoc := Radius[V21]; 944 if (RadiusLoc >= 0) then 817 945 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; 946 Inc(CityFood, TileFood[RadiusLoc]); 947 if ResourceScore[RadiusLoc] > 0 then 948 Inc(TestScore, ResourceScore[RadiusLoc]); 949 if CityScore[RadiusLoc] > BestNearCityScore then 950 BestNearCityScore := CityScore[RadiusLoc]; 951 end; 952 end; 953 if CityFood >= MinCityFood then // city is worth founding 954 begin 955 TestScore := (72 + 2 * TestScore) shl 8 + ((loc xor me) * 4567) mod 251; 867 956 // some unexactness, random but always the same for this tile 868 if TestScore>BestNearCityScore then957 if TestScore > BestNearCityScore then 869 958 begin // better than all other sites in radius 870 if BestNearCityScore>0 then // found no other cities in radius959 if BestNearCityScore > 0 then // found no other cities in radius 871 960 begin 872 for V21:=1 to 26 do961 for V21 := 1 to 26 do 873 962 begin 874 RadiusLoc:=Radius[V21];875 if (RadiusLoc>=0) then876 CityScore[RadiusLoc]:=0;963 RadiusLoc := Radius[V21]; 964 if (RadiusLoc >= 0) then 965 CityScore[RadiusLoc] := 0; 877 966 end; 878 967 end; 879 CityScore[Loc]:=TestScore968 CityScore[Loc] := TestScore; 880 969 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 970 end; 971 end; 972 end; 973 for Loc := 0 to MapSize - 1 do 974 if CityScore[Loc] > 0 then 975 AddJob(Loc, jCity, CityScore[Loc] shr 8); 976 end; 977 978 // improve terrain 979 for cix := 0 to RO.nCity - 1 do 980 with MyCity[cix] do 981 if Loc >= 0 then 982 begin // order terrain improvements 983 BestUnusedValue := 0; 984 City_GetAreaInfo(cix, CityAreaInfo); 985 V21_to_Loc(Loc, Radius); 986 for V21 := 1 to 26 do 987 if V21 <> CityOwnTile then 988 if 1 shl V21 and Tiles <> 0 then 989 begin // tile is being exploited! 990 RadiusLoc := Radius[V21]; 991 if not (Map[RadiusLoc] and fTerrain in [fDesert, fArctic]) then 992 begin 993 assert(RadiusLoc >= 0); 994 TileWorkPlan(RadiusLoc, cix, Value, NextJob, TotalWork); 995 if (NextJob = jRoad) and (Built[imPalace] + 996 Built[imCourt] + Built[imTownHall] = 0) then 997 AddJob(RadiusLoc, NextJob, 44) 998 else if NextJob <> jNone then 999 AddJob(RadiusLoc, NextJob, 84); 1000 end; 1001 end 1002 else if CityAreaInfo.Available[V21] = faAvailable then 1003 begin // tile could be exploited 1004 RadiusLoc := Radius[V21]; 1005 assert(RadiusLoc >= 0); 1006 if not (Map[RadiusLoc] and fTerrain in [fDesert, fArctic]) then 1007 begin 1008 TileWorkPlan(RadiusLoc, cix, Value, NextJob, TotalWork); 1009 Value := Value shl 16 + $FFFF - TotalWork; 1010 if Value > BestUnusedValue then 1011 begin 1012 BestUnusedValue := Value; 1013 BestUnusedLoc := RadiusLoc; 1014 end; 1015 end; 1016 end; 1017 if BestUnusedValue > 0 then 1018 begin 1019 TileWorkPlan(BestUnusedLoc, cix, Value, NextJob, TotalWork); 1020 if NextJob <> jNone then 1021 AddJob(BestUnusedLoc, NextJob, 44); 1022 end; 1023 end; 1024 1025 ScoreRoadConnections; 1026 1027 if Data.BehaviorFlags and bBarbarina = 0 then // low priority jobs 1028 for Loc := 0 to MapSize - 1 do 1029 if RO.Territory[Loc] = me then 1030 begin 1031 Tile := Map[Loc]; 1032 if Tile and fPoll <> 0 then 1033 AddJob(Loc, jPoll, 1) 1034 else 1035 case Tile and (fTerrain or fSpecial or fCity) of 1036 fGrass, fGrass + fSpecial1: 1037 if IsResearched(adExplosives) and (SpecialTile(Loc, fHills, G.lx) > 0) then 1038 AddJob(Loc, jTrans, 1); 1039 fSwamp: 1040 if SpecialTile(Loc, fSwamp, G.lx) = 0 then 1041 AddJob(Loc, jClear, 1); 1042 fTundra, fHills: 1043 if IsResearched(adExplosives) and (Tile and fTerImp <> tiMine) and 1044 (SpecialTile(Loc, fHills, G.lx) = 0) then 1045 AddJob(Loc, jTrans, 1); 1046 end; 1047 end; 1048 1049 // cities for colony ship production 1050 if Data.BehaviorFlags and bBarbarina = bBarbarina then 1051 begin 1052 for part := 0 to nShipPart - 1 do 1053 for i := 0 to ColonyShipPlan[part].nLocFoundCity - 1 do 1054 begin 1055 Loc := ColonyShipPlan[part].LocFoundCity[i]; 1056 Started := False; 1057 for uix := 0 to RO.nUn - 1 do 1058 if (MyUnit[uix].Loc = Loc) and (MyUnit[uix].Job = jCity) then 919 1059 begin 920 BestUnusedValue:=Value; 921 BestUnusedLoc:=RadiusLoc; 1060 Started := True; 1061 break; 1062 end; 1063 if not Started then 1064 begin 1065 Tile := RO.Map[Loc]; 1066 if (Tile and fTerrain = fForest) or (Tile and fTerrain = fSwamp) then 1067 AddJob(Loc, jClear, 235) 1068 else if Tile and fTerrain = fHills then 1069 begin 1070 if IsResearched(adExplosives) then 1071 AddJob(Loc, jTrans, 235); 922 1072 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) 1073 else 1074 AddJob(Loc, jCity, 235); 1075 end; 1076 V21_to_Loc(Loc, Radius); 1077 for V21 := 1 to 26 do 1078 begin 1079 Loc1 := Radius[V21]; 1080 if (Loc1 >= 0) and (RO.Map[Loc1] and (fTerrain or fSpecial) = fSwamp) then 1081 AddJob(Loc1, jClear, 255); 1082 end; 1083 end; 1084 end; 1085 1086 // choose all settlers to work 1087 for uix := 0 to RO.nUn - 1 do 1088 with MyUnit[uix] do 1089 if (Loc >= 0) and ((mix = mixSettlers) or (mix = mixSlaves) or 1090 (Data.BehaviorFlags and bBarbarina <> 0) and 1091 (MyModel[mix].Kind = mkSettler)) then 1092 begin 1093 JobAssignment_AddUnit(uix); 1094 if (District[Loc] >= 0) and (District[Loc] < maxCOD) then 1095 Inc(SettlerSurplus[District[Loc]]); 1096 end; 1097 1098 JobAssignment_Go; 1099 1100 for uix := 0 to RO.nUn - 1 do 1101 with MyUnit[uix] do 1102 if (Loc >= 0) and (Map[Loc] and fCity = 0) and (Job = jNone) and 1103 ((mix = mixSettlers) or (mix = mixSlaves)) and not JobAssignment_GotJob(uix) then 1104 Unit_MoveEx(uix, maNextCity); 1105 1106 //{$IFDEF DEBUG}DebugMessage(2, Format('Settler surplus in district 0: %d',[SettlerSurplus[0]]));{$ENDIF} 1107 1108 // add settlers to city 1109 for uix := 0 to RO.nUn - 1 do 1110 with MyUnit[uix] do 1111 if (Loc >= 0) and (Map[Loc] and fCity <> 0) and 1112 (MyModel[MyUnit[uix].mix].Kind = mkSettler) then 1113 begin 1114 dtr := District[Loc]; 1115 if (mix <> mixSettlers) or (dtr >= 0) and (dtr < maxCOD) and 1116 (SettlerSurplus[dtr] > DistrictPopulation[dtr] div 8) then 1117 begin 1118 City_FindMyCity(Loc, cix); 1119 with MyCity[cix] do 1120 if (Built[imSewer] > 0) or (Built[imAqueduct] > 0) and 1121 (Size <= NeedSewerSize - 2) or (Size <= NeedAqueductSize - 2) then 1122 begin // settlers could be added to this city 1123 Happy := BasicHappy; 1124 for i := 0 to 27 do 1125 if Built[i] > 0 then 1126 Inc(Happy); 1127 if Built[imTemple] > 0 then 1128 Inc(Happy); 1129 if Built[imCathedral] > 0 then 1130 begin 1131 Inc(Happy, 2); 1132 if RO.Wonder[woBach].EffectiveOwner = me then 1133 Inc(Happy, 1); 1134 end; 1135 if Built[imTheater] > 0 then 1136 Inc(Happy, 2); 1137 if (Built[imColosseum] > 0) or (Happy shl 1 >= Size + 2) then 1138 begin // bigger city would be happy 1139 // {$IFDEF DEBUG}DebugMessage(2, Format('Adding settlers to city at %d',[Loc]));{$ENDIF} 1140 Unit_AddToCity(uix); 1141 if (dtr >= 0) and (dtr < maxCOD) then 1142 Dec(SettlerSurplus[dtr]); 1143 end; 1034 1144 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]) 1041 end 1042 end; 1043 end 1044 end; 1145 end; 1146 end; 1045 1147 end; // ProcessSettlers 1046 1148 … … 1052 1154 procedure TAI.DoTurn; 1053 1155 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} 1156 emix, i, p1, TaxSum, ScienceSum, NewTaxRate: integer; 1157 AllHateMe: boolean; 1158 {$IFDEF PERF} 1159 PF, t0, t1, t2, t3, t4, t5, t6, t7, t8, t9: int64; 1160 {$ENDIF} 1057 1161 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} 1162 {$IFDEF DEBUG} 1163 fillchar(DebugMap, sizeof(DebugMap), 0); 1164 {$ENDIF} 1165 1166 {$IFDEF PERF} 1167 QueryPerformanceFrequency(PF); 1168 {$ENDIF} 1169 {$IFDEF PERF} 1170 QueryPerformanceCounter(t0); 1171 {$ENDIF} 1172 1173 WarNations := PresenceUnknown; 1174 for p1 := 0 to nPl - 1 do 1175 if (p1 <> me) and (1 shl p1 and RO.Alive <> 0) and (RO.Treaty[p1] < trPeace) then 1176 Inc(WarNations, 1 shl p1); 1177 BombardingNations := 0; 1178 for emix := 0 to RO.nEnemyModel - 1 do 1179 with RO.EnemyModel[emix] do 1180 if (Domain = dSea) and (1 shl (mcLongRange - mcFirstNonCap) and Cap <> 0) then 1181 BombardingNations := BombardingNations or (1 shl Owner); 1182 BombardingNations := BombardingNations and WarNations; 1183 1184 AnalyzeMap; 1185 //for i:=0 to MapSize-1 do DebugMap[i]:=Formation[i]; 1186 1187 if (Data.BehaviorFlags and bBarbarina = 0) and 1188 (RO.Tech[ResearchOrder[Data.BehaviorFlags and bGender, 8]] < tsApplicable) then 1189 CheckGender; 1190 1191 if G.Difficulty[me] < MaxDiff then // not on beginner level 1192 begin 1193 if (Data.LastResearchTech = adHorsebackRiding) and (RO.ResearchTech < 0) and 1194 (random(6) = 0) and (HavePort or (ContinentPresence[0] and not 1195 (1 shl me or PresenceUnknown) <> 0)) then 1196 begin 1197 Data.BehaviorFlags := Data.BehaviorFlags or bBarbarina_Hide; 1198 DebugMessage(1, 'Early Barbarina!'); 1199 end; 1200 if Data.BehaviorFlags and bBarbarina = 0 then 1201 begin 1202 AllHateMe := False; 1203 for p1 := 0 to nPl - 1 do 1204 if (1 shl p1 and RO.Alive <> 0) and (RO.Treaty[p1] >= trNone) then 1205 if (RO.Treaty[p1] < trPeace) and 1206 ((Data.RejectTurn[suContact, p1] >= 0) or 1207 (Data.RejectTurn[suPeace, p1] >= 0)) then 1208 AllHateMe := True 1209 else 1210 begin 1211 AllHateMe := False; 1212 break; 1213 end; 1214 if AllHateMe then 1215 begin 1216 Data.BehaviorFlags := Data.BehaviorFlags or bBarbarina_Hide; 1217 DebugMessage(1, 'All hate me!'); 1218 end; 1219 end; 1220 1221 if Data.BehaviorFlags and bBarbarina = 0 then 1222 if Barbarina_GoHidden then 1223 begin 1224 Data.BehaviorFlags := Data.BehaviorFlags or bBarbarina_Hide; 1225 DebugMessage(1, 'Barbarina!'); 1226 end; 1227 if Data.BehaviorFlags and bBarbarina = bBarbarina_Hide then 1228 if Barbarina_Go then 1229 begin 1230 Data.BehaviorFlags := Data.BehaviorFlags or bBarbarina; 1231 DebugMessage(1, 'Barbarina - no mercy!'); 1232 end; 1233 end; 1234 1235 {$IFDEF PERF} 1236 QueryPerformanceCounter(t1); 1237 {$ENDIF} 1121 1238 1122 1239 // better government form available? 1123 if (Data.BehaviorFlags and bBarbarina=0) and (RO.Turn>=LeaveDespotism) 1124 and (RO.Government<>gAnarchy) then1125 if IsResearched(adDemocracy) then1126 begin 1127 if RO.Government<>gDemocracy then1128 Revolution//!!!1240 if (Data.BehaviorFlags and bBarbarina = 0) and (RO.Turn >= LeaveDespotism) and 1241 (RO.Government <> gAnarchy) then 1242 if IsResearched(adDemocracy) then 1243 begin 1244 if RO.Government <> gDemocracy then 1245 Revolution; //!!! 1129 1246 end 1130 else if IsResearched(adTheRepublic) then1131 begin 1132 if RO.Government<>gRepublic then1133 Revolution1247 else if IsResearched(adTheRepublic) then 1248 begin 1249 if RO.Government <> gRepublic then 1250 Revolution; 1134 1251 end 1135 else if IsResearched(adMonarchy) then1136 begin 1137 if RO.Government<>gMonarchy then1138 Revolution1139 end; 1140 1141 CollectModelCatStat;1142 1143 if Data.BehaviorFlags and bBarbarina=bBarbarina then1144 begin 1145 MakeColonyShipPlan;1146 Barbarina_DoTurn1252 else if IsResearched(adMonarchy) then 1253 begin 1254 if RO.Government <> gMonarchy then 1255 Revolution; 1256 end; 1257 1258 CollectModelCatStat; 1259 1260 if Data.BehaviorFlags and bBarbarina = bBarbarina then 1261 begin 1262 MakeColonyShipPlan; 1263 Barbarina_DoTurn; 1147 1264 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 1265 else 1266 begin 1267 {$IFDEF PERF} 1268 QueryPerformanceCounter(t2); 1269 {$ENDIF} 1270 1271 {$IFDEF PERF} 1272 QueryPerformanceCounter(t3); 1273 {$ENDIF} 1274 1275 AttackAndPatrol; 1276 1277 {$IFDEF PERF} 1278 QueryPerformanceCounter(t4); 1279 {$ENDIF} 1280 1281 MoveUnitsHome; 1282 1283 {$IFDEF PERF} 1284 QueryPerformanceCounter(t5); 1285 {$ENDIF} 1286 end; 1287 1288 ProcessSettlers; 1289 1290 {$IFDEF PERF} 1291 QueryPerformanceCounter(t6); 1292 {$ENDIF} 1293 1294 if Data.BehaviorFlags and bBarbarina <> 0 then 1295 Barbarina_SetCityProduction 1296 else 1297 SetCityProduction; 1298 1299 {$IFDEF PERF} 1300 QueryPerformanceCounter(t7); 1301 {$ENDIF} 1302 1303 // correct tax rate if necessary 1304 if not IsResearched(adWheel) then 1305 ChangeRates(0, 0) 1306 else 1307 begin 1308 if (RO.TaxRate = 0) or (RO.Money < (TotalPopulation[me] - 4) * 2) then 1309 NewTaxRate := RO.TaxRate // don't check decreasing tax 1310 else 1311 NewTaxRate := RO.TaxRate - 10; 1312 while NewTaxRate < 100 do 1313 begin 1314 SumCities(NewTaxRate, TaxSum, ScienceSum); 1315 if RO.Money + TaxSum >= (TotalPopulation[me] - 4) then 1316 break; // enough 1317 Inc(NewTaxRate, 10); 1318 end; 1319 if NewTaxRate <> RO.TaxRate then 1320 begin 1321 // {$IFDEF DEBUG}DebugMessage(3,Format('New tax rate: %d',[NewTaxRate]));{$ENDIF} 1322 ChangeRates(NewTaxRate, 0); 1323 end; 1324 end; 1325 1326 // clean up RequestedTechs 1327 if (Data.LastResearchTech >= 0) and (Data.LastResearchTech <> RO.ResearchTech) then 1328 // research completed 1329 for p1 := 0 to nPl - 1 do 1330 if (p1 <> me) and (1 shl p1 and RO.Alive <> 0) and 1331 (RO.EnemyReport[p1].TurnOfCivilReport + TechReportOutdated > RO.Turn) and 1332 (RO.EnemyReport[p1].Tech[Data.LastResearchTech] < tsSeen) then 1202 1333 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; 1334 for i := 0 to nRequestedTechs - 1 do 1335 if (Data.RequestedTechs[i] >= 0) and 1336 (Data.RequestedTechs[i] shr 8 and $F = p1) then 1337 Data.RequestedTechs[i] := -1; 1338 end; 1339 if RO.ResearchTech = adMilitary then 1340 Data.LastResearchTech := -1 1341 else 1342 Data.LastResearchTech := RO.ResearchTech; 1343 for i := 0 to nRequestedTechs - 1 do 1344 if (Data.RequestedTechs[i] >= 0) and 1345 (RO.Tech[Data.RequestedTechs[i] and $FF] >= tsSeen) then 1346 Data.RequestedTechs[i] := -1; 1347 1348 // prepare negotiation 1349 AdvanceValuesSet := False; 1350 SetAdvanceValues; 1218 1351 1219 1352 … … 1225 1358 {$ENDIF} 1226 1359 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} 1360 {$IFDEF PERF} 1361 DebugMessage(2, Format('t1=%d t2=%d t3=%d t4=%d t5=%d t6=%d t7=%d t8=%d t9=%d (ns)', 1362 [(t1 - t0) * 1000000 div PF, (t2 - t1) * 1000000 div PF, (t3 - t2) * 1363 1000000 div PF, (t4 - t3) * 1000000 div PF, (t5 - t4) * 1000000 div PF, 1364 (t6 - t5) * 1000000 div PF, (t7 - t6) * 1000000 div PF, (t8 - t7) * 1365 1000000 div PF, (t9 - t8) * 1000000 div PF])); 1366 {$ENDIF} 1228 1367 end; 1229 1368 … … 1231 1370 procedure TAI.TraceAdvanceValues(Nation: integer); 1232 1371 var 1233 ad: integer;1372 ad: integer; 1234 1373 begin 1235 for ad:=0 to nAdv-1 do1236 if (RO.Tech[ad]<tsSeen) and (RO.EnemyReport[Nation].Tech[ad]>=tsApplicable)1237 and (AdvanceValue[ad]>0) then1238 begin 1239 DebugMessage(2,Format('%s (%d): +%x',1240 [Name_Advance[ad], Advancedness[ad], AdvanceValue[ad]]))1241 end 1374 for ad := 0 to nAdv - 1 do 1375 if (RO.Tech[ad] < tsSeen) and (RO.EnemyReport[Nation].Tech[ad] >= tsApplicable) and 1376 (AdvanceValue[ad] > 0) then 1377 begin 1378 DebugMessage(2, Format('%s (%d): +%x', [Name_Advance[ad], 1379 Advancedness[ad], AdvanceValue[ad]])); 1380 end; 1242 1381 end; 1382 1243 1383 {$ENDIF} 1244 1384 … … 1246 1386 procedure TAI.CheckGender; 1247 1387 var 1248 p1,NewGender: integer;1388 p1, NewGender: integer; 1249 1389 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; 1390 NewGender := -1; 1391 for p1 := 0 to nPl - 1 do 1392 if (p1 <> me) and (1 shl p1 and RO.Alive <> 0) and 1393 (RO.Treaty[p1] >= trFriendlyContact) then 1394 if PlayerHash[me] > PlayerHash[p1] then 1395 begin 1396 if NewGender = bMale then 1397 begin 1398 NewGender := -2; 1399 break; 1400 end; // ambiguous, don't change gender 1401 NewGender := bFemale; 1259 1402 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 1403 else 1404 begin 1405 if NewGender = bFemale then 1406 begin 1407 NewGender := -2; 1408 break; 1409 end; // ambiguous, don't change gender 1410 NewGender := bMale; 1411 end; 1412 if (NewGender >= 0) and (NewGender <> Data.BehaviorFlags and bGender) then 1413 begin 1414 Data.BehaviorFlags := Data.BehaviorFlags and not bGender or NewGender; 1415 DebugMessage(1, 'Gender:=' + char(48 + NewGender)); 1416 end; 1271 1417 end; 1272 1418 … … 1276 1422 procedure RateResearchAdv(ad, Time: integer); 1277 1423 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; 1424 Value: integer; 1425 begin 1426 if Time = 0 then 1427 Value := TechValue_ForResearch_Next 1428 else 1429 Value := TechValue_ForResearch - Time; 1430 if AdvanceValue[ad] < Value then 1431 AdvanceValue[ad] := Value; 1284 1432 end; 1285 1433 1286 1434 procedure SetPreqValues(ad, Value: integer); 1287 1435 begin 1288 if (RO.Tech[ad]<tsSeen) and (ad<>RO.ResearchTech) then1289 begin 1290 if AdvanceValue[ad]<Value then1291 AdvanceValue[ad]:=Value;1292 if ad=adScience then1293 begin 1294 SetPreqValues(adTheology,Value-1);1295 SetPreqValues(adPhilosophy,Value-1);1436 if (RO.Tech[ad] < tsSeen) and (ad <> RO.ResearchTech) then 1437 begin 1438 if AdvanceValue[ad] < Value then 1439 AdvanceValue[ad] := Value; 1440 if ad = adScience then 1441 begin 1442 SetPreqValues(adTheology, Value - 1); 1443 SetPreqValues(adPhilosophy, Value - 1); 1296 1444 end 1297 else if ad=adMassProduction then1445 else if ad = adMassProduction then 1298 1446 // preqs should be researched now 1299 else1300 begin 1301 if AdvPreq[ad,0]>=0 then1302 SetPreqValues(AdvPreq[ad,0],Value-1);1303 if AdvPreq[ad,1]>=0 then1304 SetPreqValues(AdvPreq[ad,1],Value-1);1305 end; 1306 end 1447 else 1448 begin 1449 if AdvPreq[ad, 0] >= 0 then 1450 SetPreqValues(AdvPreq[ad, 0], Value - 1); 1451 if AdvPreq[ad, 1] >= 0 then 1452 SetPreqValues(AdvPreq[ad, 1], Value - 1); 1453 end; 1454 end; 1307 1455 end; 1308 1456 1309 1457 procedure RateImpPreq(iix, Value: integer); 1310 1458 begin 1311 if (Value>0) and (Imp[iix].Preq>=0) then1312 inc(AdvanceValue[Imp[iix].Preq],Value);1459 if (Value > 0) and (Imp[iix].Preq >= 0) then 1460 Inc(AdvanceValue[Imp[iix].Preq], Value); 1313 1461 end; 1314 1462 1315 1463 var 1316 emix,cix,adMissing,iad,ad,count,i,Time,d,CurrentCost,CurrentStrength,1317 MaxSize, MaxTrade: integer;1318 PreView,Emergency,Bombarded: boolean;1464 emix, cix, adMissing, iad, ad, Count, i, Time, d, CurrentCost, 1465 CurrentStrength, MaxSize, MaxTrade: integer; 1466 PreView, Emergency, Bombarded: boolean; 1319 1467 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 1468 if AdvanceValuesSet then 1469 exit; 1470 AdvanceValuesSet := True; 1471 1472 fillchar(AdvanceValue, sizeof(AdvanceValue), 0); 1473 1474 // rate techs to ensure research progress 1475 Time := 0; 1476 for ad := 0 to nAdv - 1 do 1477 if RO.Tech[ad] = tsSeen then 1478 Inc(Time); 1479 adMissing := -1; 1480 Emergency := True; 1481 for iad := 0 to nResearchOrder - 1 do 1482 begin 1483 ad := ResearchOrder[Data.BehaviorFlags and bGender, iad]; 1484 if (ad <> RO.ResearchTech) and (RO.Tech[ad] < tsSeen) then 1485 begin 1486 if adMissing < 0 then 1487 adMissing := ad; 1488 RateResearchAdv(ad, Time); // unseen tech of own gender 1489 if AdvPreq[ad, 2] <> preNone then 1338 1490 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 1491 Count := 0; 1492 for i := 0 to 2 do 1493 if (AdvPreq[ad, i] = RO.ResearchTech) or 1494 (RO.Tech[AdvPreq[ad, i]] >= tsSeen) then 1495 Inc(Count); 1496 if Count >= 2 then 1497 Emergency := False 1498 else 1499 begin 1500 if ad <> adMassProduction then // don't score third preq for MP 1501 begin 1502 for i := 0 to 2 do 1503 if (AdvPreq[ad, i] <> RO.ResearchTech) and 1504 (RO.Tech[AdvPreq[ad, i]] < tsSeen) then 1505 RateResearchAdv(AdvPreq[ad, i], Time); 1506 end; 1507 Inc(Time, 2 - Count); 1508 end; 1509 end 1345 1510 else 1346 begin 1347 if ad<>adMassProduction then // don't score third preq for MP 1511 begin 1512 Count := 0; 1513 for i := 0 to 1 do 1514 if (AdvPreq[ad, i] <> preNone) and (AdvPreq[ad, i] <> RO.ResearchTech) and 1515 (RO.Tech[AdvPreq[ad, i]] < tsSeen) then 1348 1516 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); 1517 RateResearchAdv(AdvPreq[ad, i], Time); 1518 Inc(Count); 1353 1519 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); 1520 if Count = 0 then 1521 Emergency := False; 1522 Inc(Time, Count); 1523 end; 1524 Inc(Time, 2); 1525 end; 1526 end; 1527 if Emergency and (adMissing >= 0) then 1528 begin 1529 {$IFDEF DEBUG} 1530 DebugMessage(2, 'Research emergency: Go for' + Name_Advance[adMissing] + ' now!'); 1531 {$ENDIF} 1532 SetPreqValues(adMissing, TechValue_ForResearch_Urgent); 1533 end; 1534 for iad := 0 to nResearchOrder - 1 do 1535 begin 1536 ad := ResearchOrder[Data.BehaviorFlags and bGender xor 1, iad]; 1537 if ad = adScience then 1538 Inc(AdvanceValue[ad], 5 * TechValue_ForResearch_LeaveOut) 1539 else if LeaveOutValue[ad] > 0 then 1540 if AdvanceValue[ad] > 0 then 1541 Inc(AdvanceValue[ad], LeaveOutValue[ad] * TechValue_ForResearch_LeaveOut); 1542 // else AdvanceValue[ad]:=1; 1543 end; 1544 1545 // rate military techs 1546 for d := 0 to nDomains - 1 do 1547 begin 1548 CurrentCost := 0; 1549 CurrentStrength := 0; 1550 for PreView := True downto False do 1551 for i := 0 to nUpgrade - 1 do 1552 with Upgrade[d, i] do 1553 if (Preq >= 0) and not (Preq in FutureTech) then 1554 if ((Ro.ResearchTech = Preq) or (RO.Tech[Preq] >= tsSeen)) = PreView then 1555 if PreView then 1556 begin 1557 if Cost > CurrentCost then 1558 CurrentCost := Cost; 1559 Inc(CurrentStrength, Strength); 1560 end 1561 else 1562 begin // rate 1563 if (i > 0) and (Trans > 0) then 1564 Inc(AdvanceValue[Preq], $400); 1565 if Cost <= CurrentCost then 1566 Inc(AdvanceValue[Preq], (4 - d) * Strength * $400 div 1567 (CurrentStrength + Upgrade[d, 0].Strength)) 1568 else 1569 Inc(AdvanceValue[Preq], (4 - d) * Strength * $200 div 1570 (CurrentStrength + Upgrade[d, 0].Strength)); 1571 end; 1572 end; 1573 // speed 1574 Inc(AdvanceValue[adSteamEngine], $400); 1575 Inc(AdvanceValue[adNuclearPower], $400); 1576 Inc(AdvanceValue[adRocketry], $400); 1577 // features 1578 Inc(AdvanceValue[adBallistics], $800); 1579 Inc(AdvanceValue[adCommunism], $800); 1580 // weight 1581 Inc(AdvanceValue[adAutomobile], $800); 1582 Inc(AdvanceValue[adSteel], $800); 1583 Inc(AdvanceValue[adAdvancedFlight], $400); 1584 1585 // civil non-improvement 1586 if RO.Turn >= LeaveDespotism then 1587 begin 1588 Inc(AdvanceValue[adDemocracy], $80 * RO.nCity); 1589 Inc(AdvanceValue[adTheRepublic], $800); 1590 end; 1591 Inc(AdvanceValue[adRailroad], $800); 1592 // inc(AdvanceValue[adExplosives],$800); // no, has enough 1593 Inc(AdvanceValue[adBridgeBuilding], $200); 1594 Inc(AdvanceValue[adSpaceFlight], $200); 1595 Inc(AdvanceValue[adSelfContainedEnvironment], $200); 1596 Inc(AdvanceValue[adImpulseDrive], $200); 1597 Inc(AdvanceValue[adTransstellarColonization], $200); 1598 1599 // city improvements 1600 MaxSize := 0; 1601 for cix := 0 to RO.nCity - 1 do 1602 if MyCity[cix].Size > MaxSize then 1603 MaxSize := MyCity[cix].Size; 1604 if RO.Government in [gRepublic, gDemocracy, gLybertarianism] then 1605 MaxTrade := (MaxSize - 1) * 3 1606 else 1607 MaxTrade := (MaxSize - 1) * 2; 1608 1609 RateImpPreq(imCourt, (RO.nCity - 1) * $100); 1610 RateImpPreq(imLibrary, (MaxTrade - 10) * $180); 1611 RateImpPreq(imMarket, (MaxTrade - 10) * $140); 1612 RateImpPreq(imUniversity, (MaxTrade - 10) * $140); 1613 RateImpPreq(imBank, (MaxTrade - 10) * $100); 1614 RateImpPreq(imObservatory, (MaxTrade - 10) * $100); 1615 RateImpPreq(imResLab, (MaxTrade - 14) * $140); 1616 RateImpPreq(imStockEx, (MaxTrade - 10) * $10 * (RO.nCity - 1)); 1617 RateImpPreq(imHighways, (MaxSize - 5) * $200); 1618 RateImpPreq(imFactory, (MaxSize - 8) * $200); 1619 RateImpPreq(imMfgPlant, (MaxSize - 8) * $1C0); 1620 RateImpPreq(imRecycling, (MaxSize - 8) * $180); 1621 RateImpPreq(imHarbor, (MaxSize - 7) * $200); 1622 RateImpPreq(imSuperMarket, $300); 1623 if RO.Turn >= 40 then 1624 RateImpPreq(imTemple, $400); 1625 if RO.Government <> gDespotism then 1626 begin 1627 RateImpPreq(imCathedral, $400); 1628 RateImpPreq(imTheater, $400); 1629 end; 1630 if MaxSize >= NeedAqueductSize - 1 then 1631 begin 1632 RateImpPreq(imAqueduct, $600); 1633 RateImpPreq(imGrWall, $300); 1634 end; 1635 if cixStateImp[imPalace] >= 0 then 1636 with MyCity[cixStateImp[imPalace]] do 1637 if (Built[imColosseum] + Built[imObservatory] > 0) and 1638 (Size >= NeedSewerSize - 1) then 1639 RateImpPreq(imSewer, $400); 1640 Bombarded := False; 1641 for emix := 0 to RO.nEnemyModel - 1 do 1642 if 1 shl (mcLongRange - mcFirstNonCap) and RO.EnemyModel[emix].Cap <> 0 then 1643 Bombarded := True; 1644 if Bombarded then 1645 RateImpPreq(imCoastalFort, $400); 1482 1646 end; 1483 1647 1484 1648 procedure TAI.AnalyzeMap; 1485 1649 var 1486 cix,Loc,Loc1,V8,f1,p1: integer;1487 Adjacent: TVicinity8Loc;1650 cix, Loc, Loc1, V8, f1, p1: integer; 1651 Adjacent: TVicinity8Loc; 1488 1652 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: 1653 inherited; 1654 1655 // collect nation presence information for continents and oceans 1656 fillchar(ContinentPresence, sizeof(ContinentPresence), 0); 1657 fillchar(OceanPresence, sizeof(OceanPresence), 0); 1658 for Loc := 0 to MapSize - 1 do 1659 begin 1660 f1 := Formation[Loc]; 1661 case f1 of 1662 0..maxCOD - 1: 1663 begin 1664 p1 := RO.Territory[Loc]; 1665 if p1 >= 0 then 1666 if Map[Loc] and fTerrain >= fGrass then 1667 ContinentPresence[f1] := ContinentPresence[f1] or (1 shl p1) 1668 else 1669 OceanPresence[f1] := OceanPresence[f1] or (1 shl p1); 1670 end; 1671 nfUndiscovered: 1507 1672 begin // adjacent formations are not completely discovered 1508 V8_to_Loc(Loc,Adjacent);1509 for V8:=0 to 7 do1510 begin 1511 Loc1:=Adjacent[V8];1512 if Loc1>=0 then1673 V8_to_Loc(Loc, Adjacent); 1674 for V8 := 0 to 7 do 1675 begin 1676 Loc1 := Adjacent[V8]; 1677 if Loc1 >= 0 then 1513 1678 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: 1679 f1 := Formation[Loc1]; 1680 if (f1 >= 0) and (f1 < maxCOD) then 1681 if Map[Loc1] and fTerrain >= fGrass then 1682 ContinentPresence[f1] := ContinentPresence[f1] or PresenceUnknown 1683 else 1684 OceanPresence[f1] := OceanPresence[f1] or PresenceUnknown; 1685 end; 1686 end; 1687 end; 1688 nfPeace: 1523 1689 begin // nation present in adjacent formations 1524 V8_to_Loc(Loc,Adjacent);1525 for V8:=0 to 7 do1526 begin 1527 Loc1:=Adjacent[V8];1528 if Loc1>=0 then1690 V8_to_Loc(Loc, Adjacent); 1691 for V8 := 0 to 7 do 1692 begin 1693 Loc1 := Adjacent[V8]; 1694 if Loc1 >= 0 then 1529 1695 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; 1696 f1 := Formation[Loc1]; 1697 if (f1 >= 0) and (f1 < maxCOD) then 1698 if Map[Loc1] and fTerrain >= fGrass then 1699 ContinentPresence[f1] := 1700 ContinentPresence[f1] or (1 shl RO.Territory[Loc]) 1701 else 1702 OceanPresence[f1] := OceanPresence[f1] or (1 shl RO.Territory[Loc]); 1703 end; 1704 end; 1705 end; 1706 end; 1707 end; 1708 1709 fillchar(TotalPopulation, sizeof(TotalPopulation), 0); 1710 fillchar(ContinentPopulation, sizeof(ContinentPopulation), 0); 1711 fillchar(DistrictPopulation, 4 * nDistrict, 0); 1712 1713 // count population 1714 for cix := 0 to RO.nEnemyCity - 1 do 1715 with RO.EnemyCity[cix] do 1716 if Loc >= 0 then 1717 begin 1718 Inc(TotalPopulation[Owner], Size); 1719 if (Formation[Loc] >= 0) and (Formation[Loc] < maxCOD) then 1720 Inc(ContinentPopulation[Owner, Formation[Loc]], Size); 1721 end; 1722 for cix := 0 to RO.nCity - 1 do 1723 with RO.City[cix] do 1724 if Loc >= 0 then 1725 begin 1726 Inc(TotalPopulation[me], Size); 1727 assert(District[Loc] >= 0); 1728 if District[Loc] < maxCOD then 1729 Inc(DistrictPopulation[District[Loc]], Size); 1730 end; 1561 1731 end; 1562 1732 1563 1733 procedure TAI.CollectModelCatStat; 1564 1734 var 1565 i,uix,Cat,mix,Quality: integer;1735 i, uix, Cat, mix, Quality: integer; 1566 1736 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 1737 // categorize models 1738 for Cat := 0 to nModelCat - 1 do 1739 ModelBestQuality[Cat] := 0; 1740 mixCaravan := -1; 1741 mixSlaves := -1; 1742 mixCruiser := -1; 1743 for mix := 0 to RO.nModel - 1 do 1744 begin 1745 ModelCat[mix] := mctNone; 1746 if mix = 1 then 1747 mixMilitia := mix 1748 else 1749 case MyModel[mix].Kind of 1750 $00..$0F: // common units 1751 if MyModel[mix].Cap[mcNav] > 0 then 1752 mixCruiser := mix // temporary!!! 1753 else 1582 1754 begin 1583 RateMyModel(mix,Cat,Quality);1584 ModelCat[mix]:=Cat;1585 ModelQuality[mix]:=Quality;1586 if (Cat>=0) and (Quality>ModelBestQuality[Cat]) then1587 ModelBestQuality[Cat]:=Quality;1755 RateMyModel(mix, Cat, Quality); 1756 ModelCat[mix] := Cat; 1757 ModelQuality[mix] := Quality; 1758 if (Cat >= 0) and (Quality > ModelBestQuality[Cat]) then 1759 ModelBestQuality[Cat] := Quality; 1588 1760 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; 1761 mkSpecial_TownGuard: mixTownGuard := mix; 1762 mkSettler: mixSettlers := mix; // engineers always have higher mix 1763 mkCaravan: mixCaravan := mix; 1764 mkSlaves: mixSlaves := mix 1765 end; 1766 end; 1767 1768 // mark obsolete models with quality=0 1769 for mix := 0 to RO.nModel - 1 do 1770 if (MyModel[mix].Kind < $10) and (ModelCat[mix] >= 0) and 1771 (ModelQuality[mix] + MaxExistWorseThanBestModel < 1772 ModelBestQuality[ModelCat[mix]]) then 1773 ModelQuality[mix] := ModelQuality[mix] - $40000000; 1774 1775 OceanWithShip := 0; 1776 if mixCruiser >= 0 then 1777 for uix := 0 to RO.nUn - 1 do 1778 with MyUnit[uix] do 1779 if (Loc >= 0) and (mix = mixCruiser) and (Map[Loc] and fTerrain < fGrass) then 1780 begin 1781 i := Formation[Loc]; 1782 if (i >= 0) and (i < maxCOD) then 1783 OceanWithShip := OceanWithShip or (1 shl i); 1784 end; 1611 1785 end; 1612 1786 … … 1614 1788 procedure TAI.MoveUnitsHome; 1615 1789 const 1616 PatrolDestination=lxmax*lymax;1617 FirstSurplusLoop: array[mctGroundDefender..mctGroundAttacker] of integer= (2,1);1790 PatrolDestination = lxmax * lymax; 1791 FirstSurplusLoop: array[mctGroundDefender..mctGroundAttacker] of integer = (2, 1); 1618 1792 var 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;1793 Cat, i, mix, cix, uix, Loop, nModelOrder: integer; 1794 Adjacent: TVicinity8Loc; 1795 LocNeed: array[0..lxmax * lymax - 1] of shortint; 1796 Destination: array[0..nUmax - 1] of integer; 1797 DistrictNeed, DistrictNeed0: array[0..maxCOD - 1] of integer; 1798 ModelOrder: array[0..nMmax - 1] of integer; 1799 complete, Fortified: boolean; 1626 1800 1627 1801 function IsBombarded(cix: integer): boolean; 1628 1802 var 1629 Loc1,V8: integer; 1630 Adjacent: TVicinity8Loc; 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; 1803 Loc1, V8: integer; 1804 Adjacent: TVicinity8Loc; 1805 begin 1806 Result := False; 1807 if BombardingNations <> 0 then 1808 with MyCity[cix] do 1809 begin 1810 V8_to_Loc(Loc, Adjacent); 1811 for V8 := 0 to 7 do 1812 begin 1813 Loc1 := Adjacent[V8]; 1814 if (Loc1 >= 0) and (Map[Loc1] and fTerrain < fGrass) and 1815 (Formation[Loc1] >= 0) and (Formation[Loc1] < maxCOD) and 1816 (OceanPresence[Formation[Loc1]] and (BombardingNations or 1817 PresenceUnknown) <> 0) then 1818 begin 1819 Result := True; 1820 exit; 1821 end; 1822 end; 1823 end; 1645 1824 end; 1646 1825 1647 1826 procedure TryUtilize(uix: integer); 1648 1827 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 1828 cix, ProdCost, UtilizeCost: integer; 1829 begin 1830 if (MyUnit[uix].Health = 100) and (Map[MyUnit[uix].Loc] and 1831 (fCity or fOwned) = fCity or fOwned) then 1832 begin 1833 City_FindMyCity(MyUnit[uix].Loc, cix); 1834 with MyCity[cix] do 1835 if Project and cpImp = 0 then 1836 begin 1837 ProdCost := MyModel[Project and cpIndex].Cost; 1838 UtilizeCost := MyModel[MyUnit[uix].mix].Cost; 1839 if Prod < (ProdCost - UtilizeCost * 2 div 3) * 1840 BuildCostMod[G.Difficulty[me]] div 12 then 1841 Unit_Disband(uix); 1842 end; 1843 end; 1663 1844 end; 1664 1845 1665 1846 procedure FindDestination(uix: integer); 1666 1847 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); 1671 Pile.Create(MapSize); 1672 with MyUnit[uix] do 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; 1848 MoveStyle, V8, Loc1, Time, NextLoc, NextTime, RecoverTurns: integer; 1849 Reached: array[0..lxmax * lymax - 1] of boolean; 1850 begin 1851 fillchar(Reached, MapSize, False); 1852 Pile.Create(MapSize); 1853 with MyUnit[uix] do 1854 begin 1855 Pile.Put(Loc, $800 - Movement); 1856 MoveStyle := GetMyMoveStyle(mix, 100); 1857 end; 1858 while Pile.Get(Loc1, Time) do 1859 begin 1860 if LocNeed[Loc1] > 0 then 1861 begin 1862 LocNeed[Loc1] := 0; 1863 if (District[Loc1] >= 0) and (District[Loc1] < maxCOD) then 1864 begin 1865 assert(DistrictNeed[District[Loc1]] > 0); 1866 Dec(DistrictNeed[District[Loc1]]); 1867 end; 1868 Destination[uix] := Loc1; 1869 break; 1870 end; 1871 Reached[Loc1] := True; 1872 V8_to_Loc(Loc1, Adjacent); 1873 for V8 := 0 to 7 do 1874 begin 1875 NextLoc := Adjacent[V8]; 1876 if (NextLoc >= 0) and not Reached[NextLoc] and (RO.Territory[NextLoc] = me) then 1877 case CheckStep(MoveStyle, Time, V8 and 1, NextTime, RecoverTurns, 1878 Map[Loc1], Map[NextLoc], False) of 1879 csOk: 1880 Pile.Put(NextLoc, NextTime); 1881 csForbiddenTile: 1882 Reached[NextLoc] := True; // don't check moving there again 1883 csCheckTerritory: 1884 assert(False); 1885 end; 1886 end; 1887 end; 1888 Pile.Free; 1707 1889 end; 1708 1890 1709 1891 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; 1892 if not (RO.Government in [gAnarchy, gDespotism]) then // utilize townguards 1893 for uix := 0 to RO.nUn - 1 do 1894 with MyUnit[uix] do 1895 if (Loc >= 0) and (Master < 0) and (mix = mixTownGuard) then 1896 Unit_Disband(uix); 1897 1898 fillchar(UnitLack, sizeof(UnitLack), 0); 1899 fillchar(Destination, 4 * RO.nUn, $FF); 1900 for i := 0 to maxCOD - 1 do 1901 if uixPatrol[i] >= 0 then 1902 Destination[uixPatrol[i]] := PatrolDestination; 1903 for uix := 0 to RO.nUn - 1 do 1904 if (MyUnit[uix].mix = mixMilitia) or (MyUnit[uix].mix = mixCruiser) then 1905 Destination[uix] := PatrolDestination; 1906 1907 // distribute attackers and defenders 1908 for Cat := mctGroundDefender to mctGroundAttacker do 1909 begin 1910 nModelOrder := 0; 1911 for mix := 0 to Ro.nModel - 1 do 1912 if ModelCat[mix] = Cat then 1913 begin 1914 i := nModelOrder; 1915 while (i > 0) and (ModelQuality[mix] < ModelQuality[ModelOrder[i - 1]]) do 1916 begin 1917 ModelOrder[i] := ModelOrder[i - 1]; 1918 Dec(i); 1919 end; 1920 ModelOrder[i] := mix; 1921 Inc(nModelOrder); 1922 end; 1923 1924 Loop := 0; 1925 repeat 1926 if Loop = FirstSurplusLoop[Cat] then 1927 for uix := 0 to RO.nUn - 1 do 1928 with MyUnit[uix] do 1929 if (Loc >= 0) and (Destination[uix] < 0) and (Master < 0) and 1930 (ModelCat[mix] = Cat) and (ModelQuality[mix] < 0) then 1931 TryUtilize(uix); 1932 1933 fillchar(LocNeed, MapSize, 0); 1934 fillchar(DistrictNeed, sizeof(DistrictNeed), 0); 1935 1936 for cix := 0 to RO.nCity - 1 do 1937 with MyCity[cix] do 1938 if Loc >= 0 then 1939 if ((Cat <> mctGroundDefender) or (Loop <> 0) or IsBombarded(cix)) and 1940 ((Loop <> FirstSurplusLoop[Cat]) or 1941 (Built[imBarracks] + Built[imMilAcademy] > 0)) and 1942 ((Loop <> FirstSurplusLoop[Cat] + 1) or 1943 (Built[imBarracks] + Built[imMilAcademy] = 0)) then 1944 begin 1945 LocNeed[Loc] := 1; 1946 if (District[Loc] >= 0) and (District[Loc] < maxCOD) then 1947 begin 1948 Inc(DistrictNeed[District[Loc]]); 1949 if Loop < FirstSurplusLoop[Cat] then 1950 Inc(UnitLack[District[Loc], Cat]); 1951 end; 1952 end; 1953 1954 if Loop = 0 then // protect city building sites 1955 for uix := 0 to RO.nUn - 1 do 1956 with MyUnit[uix] do 1957 if (Loc >= 0) and (Job = jCity) and (RO.Territory[Loc] = me) then 1958 begin 1959 LocNeed[Loc] := 1; 1960 if (District[Loc] >= 0) and (District[Loc] < maxCOD) then 1961 Inc(DistrictNeed[District[Loc]]); 1962 end; 1963 1964 complete := Loop >= FirstSurplusLoop[Cat]; 1965 for i := nModelOrder - 1 downto 0 do 1966 begin 1967 for Fortified := True downto False do 1968 for uix := 0 to RO.nUn - 1 do 1969 with MyUnit[uix] do 1970 if (mix = ModelOrder[i]) and (Loc >= 0) and 1971 (Destination[uix] < 0) and (Master < 0) and 1972 ((Flags and unFortified <> 0) = Fortified) and (LocNeed[Loc] > 0) then 1973 begin 1974 LocNeed[Loc] := 0; 1975 if (District[Loc] >= 0) and (District[Loc] < maxCOD) then 1976 Dec(DistrictNeed[District[Loc]]); 1977 Destination[uix] := Loc; 1978 complete := False; 1979 end; 1980 1981 for uix := 0 to RO.nUn - 1 do 1982 with MyUnit[uix] do 1983 if (mix = ModelOrder[i]) and (Loc >= 0) and (Destination[uix] < 0) and 1984 (Master < 0) then 1985 if (District[Loc] >= 0) and (District[Loc] < maxCOD) and 1986 (DistrictNeed[District[Loc]] = 0) then 1987 else 1988 begin // unassigned unit 1989 FindDestination(uix); 1990 if Destination[uix] >= 0 then 1991 complete := False; 1992 end; 1993 end; 1994 Inc(Loop) 1995 until complete; 1996 end; 1997 1998 // distribute obsolete settlers 1739 1999 repeat 1740 if Loop=FirstSurplusLoop[Cat] then1741 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do1742 if (Loc>=0) and (Destination[uix]<0) and (Master<0)1743 and (ModelCat[mix]=Cat)1744 and (ModelQuality[mix]<0) then1745 TryUtilize(uix);1746 1747 2000 fillchar(LocNeed, MapSize, 0); 1748 2001 fillchar(DistrictNeed, sizeof(DistrictNeed), 0); 1749 2002 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 2003 for cix := 0 to RO.nCity - 1 do 2004 with MyCity[cix] do 2005 if Loc >= 0 then 2006 if (Built[imSewer] > 0) or (Built[imAqueduct] > 0) and 2007 (Size <= NeedSewerSize - 2) or (Size <= NeedAqueductSize - 2) or 2008 (Project = mixSettlers) then 1757 2009 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]]); 2010 LocNeed[Loc] := 1; 2011 if (District[Loc] >= 0) and (District[Loc] < maxCOD) then 2012 Inc(DistrictNeed[District[Loc]]); 1771 2013 end; 1772 1773 complete:= Loop>=FirstSurplusLoop[Cat]; 1774 for i:=nModelOrder-1 downto 0 do1775 begin1776 for Fortified:=true downto falsedo1777 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do1778 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) then2014 DistrictNeed0 := DistrictNeed; 2015 2016 complete := True; 2017 for uix := 0 to RO.nUn - 1 do 2018 with MyUnit[uix] do 2019 if (Loc >= 0) and (Destination[uix] < 0) and (Master < 0) then 2020 if (MyModel[mix].Kind = mkSettler) and (mix <> mixSettlers) and 2021 (Job = jNone) then 2022 if (District[Loc] >= 0) and (District[Loc] < maxCOD) and 2023 (DistrictNeed[District[Loc]] = 0) then 1782 2024 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; 2025 if DistrictNeed0[District[Loc]] > 0 then 2026 complete := False; 2027 end 2028 else 2029 begin // unassigned unit 2030 FindDestination(uix); 2031 // if (Destination[uix]<0) and (RO.Territory[Loc]=me) then 2032 // complete:=false; // causes hangup when unit can't move due to zoc 1788 2033 end; 1789 1790 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do1791 if (mix=ModelOrder[i])1792 and (Loc>=0) and (Destination[uix]<0) and (Master<0) then1793 if (District[Loc]>=0) and (District[Loc]<maxCOD)1794 and (DistrictNeed[District[Loc]]=0) then1795 else1796 begin // unassigned unit1797 FindDestination(uix);1798 if Destination[uix]>=0 then complete:=false;1799 end;1800 end;1801 inc(Loop)1802 2034 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; 2035 2036 for uix := 0 to RO.nUn - 1 do 2037 with MyUnit[uix] do 2038 if Loc >= 0 then 2039 if Destination[uix] < 0 then 2040 begin 2041 if (MyModel[mix].Kind <> mkSettler) and (MyModel[mix].Kind <> mkSlaves) and 2042 (Master < 0) and (Map[Loc] and fCity = 0) then 2043 Unit_MoveEx(uix, maNextCity); 2044 end 2045 else if (Destination[uix] <> PatrolDestination) and 2046 (Loc <> Destination[uix]) then 2047 Unit_MoveEx(uix, Destination[uix]); 2048 2049 for uix := 0 to RO.nUn - 1 do 2050 with MyUnit[uix] do 2051 if (Loc >= 0) and (RO.Territory[Loc] = me) and (District[Loc] >= 0) and 2052 (District[Loc] < maxCOD) and (ModelQuality[mix] > 0) then 2053 case ModelCat[mix] of 2054 mctGroundDefender, mctGroundAttacker: 2055 Dec(UnitLack[District[Loc], ModelCat[mix]]) 2056 end; 1859 2057 end; // MoveUnitsHome 1860 2058 … … 1862 2060 procedure TAI.CheckAttack(uix: integer); 1863 2061 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;2062 AttackScore, BestCount, AttackLoc, TestLoc, NextLoc, TestTime, V8, 2063 TestScore, euix, MyDamage, EnemyDamage, OldLoc, AttackForecast, 2064 MoveResult, AttackResult, MoveStyle, NextTime, RecoverTurns: integer; 2065 Tile: cardinal; 2066 Exhausted: boolean; 2067 Adjacent: TVicinity8Loc; 2068 Reached: array[0..lxmax * lymax - 1] of boolean; 1871 2069 1872 2070 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 2071 with MyUnit[uix] do 2072 begin 2073 MoveStyle := GetMyMoveStyle(mix, Health); 2074 repeat 2075 AttackScore := -999999; 2076 AttackLoc := -1; 2077 fillchar(Reached, MapSize, False); 2078 Pile.Create(MapSize); 2079 Pile.Put(Loc, $800 - Movement); 2080 // start search for something to do at current location 2081 while Pile.Get(TestLoc, TestTime) do 2082 begin 2083 TestScore := 0; 2084 Tile := Map[TestLoc]; 2085 Reached[TestLoc] := True; 2086 2087 if ((Tile and fUnit) <> 0) and ((Tile and fOwned) = 0) then 1889 2088 begin // enemy unit 1890 assert(TestTime<$1000);1891 Unit_FindEnemyDefender(TestLoc,euix);1892 if RO.Treaty[RO.EnemyUn[euix].Owner]<trPeace then1893 if Unit_AttackForecast(uix,TestLoc,$800-TestTime,AttackForecast) then2089 assert(TestTime < $1000); 2090 Unit_FindEnemyDefender(TestLoc, euix); 2091 if RO.Treaty[RO.EnemyUn[euix].Owner] < trPeace then 2092 if Unit_AttackForecast(uix, TestLoc, $800 - TestTime, AttackForecast) then 1894 2093 begin // attack possible, but advantageous? 1895 if AttackForecast=0 then2094 if AttackForecast = 0 then 1896 2095 begin // enemy unit would be destroyed 1897 MyDamage:=Health+DestroyBonus;1898 EnemyDamage:=RO.EnemyUn[euix].Health+DestroyBonus;2096 MyDamage := Health + DestroyBonus; 2097 EnemyDamage := RO.EnemyUn[euix].Health + DestroyBonus; 1899 2098 end 1900 else if AttackForecast>0 then2099 else if AttackForecast > 0 then 1901 2100 begin // enemy unit would be destroyed 1902 MyDamage:=Health-AttackForecast;1903 EnemyDamage:=RO.EnemyUn[euix].Health+DestroyBonus;2101 MyDamage := Health - AttackForecast; 2102 EnemyDamage := RO.EnemyUn[euix].Health + DestroyBonus; 1904 2103 end 1905 else // own unit would be destroyed2104 else // own unit would be destroyed 1906 2105 begin 1907 MyDamage:=Health+DestroyBonus;1908 EnemyDamage:=RO.EnemyUn[euix].Health+AttackForecast;2106 MyDamage := Health + DestroyBonus; 2107 EnemyDamage := RO.EnemyUn[euix].Health + AttackForecast; 1909 2108 end; 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 2109 TestScore := Aggressive * 2 * 2110 (EnemyDamage * RO.EnemyModel[RO.EnemyUn[euix].emix].Cost) div 2111 (MyDamage * MyModel[mix].Cost); 2112 if TestScore <= 100 then 2113 TestScore := 0 // own losses exceed enemy losses, no good 2114 else 1915 2115 begin 1916 if TestScore>AttackScore then1917 BestCount:=0;1918 if TestScore>=AttackScore then2116 if TestScore > AttackScore then 2117 BestCount := 0; 2118 if TestScore >= AttackScore then 1919 2119 begin 1920 inc(BestCount);1921 if random(BestCount)=0 then2120 Inc(BestCount); 2121 if random(BestCount) = 0 then 1922 2122 begin 1923 AttackScore:=TestScore;1924 AttackLoc:=TestLoc;1925 end 2123 AttackScore := TestScore; 2124 AttackLoc := TestLoc; 2125 end; 1926 2126 end; 1927 end 2127 end; 1928 2128 end; 1929 2129 end // enemy unit 1930 2130 1931 else if ((Tile and fCity)<>0) and ((Tile and fOwned)=0) then2131 else if ((Tile and fCity) <> 0) and ((Tile and fOwned) = 0) then 1932 2132 // enemy city 1933 2133 1934 else2134 else 1935 2135 begin // no enemy city or unit here 1936 V8_to_Loc(TestLoc,Adjacent);1937 for V8:=0 to 7 do2136 V8_to_Loc(TestLoc, Adjacent); 2137 for V8 := 0 to 7 do 1938 2138 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 2139 NextLoc := Adjacent[V8]; 2140 if (NextLoc >= 0) and not Reached[NextLoc] and 2141 (Map[NextLoc] and fTerrain <> fUNKNOWN) then 2142 if Map[NextLoc] and (fUnit or fOwned) = fUnit then 2143 Pile.Put(NextLoc, TestTime) // foreign unit! 2144 else 2145 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 2146 RecoverTurns, Map[Loc], Map[NextLoc], True) of 2147 csOk, csCheckTerritory: 2148 if NextTime < $1000 then 2149 Pile.Put(NextLoc, NextTime); 2150 csForbiddenTile: 2151 Reached[NextLoc] := True; // don't check moving there again 2152 end; 1951 2153 end; 1952 2154 end; // no enemy city or unit here 1953 2155 end; // while Pile.Get 1954 Pile.Free;1955 1956 if AttackLoc>=0 then1957 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 then1963 if Movement<100 then1964 Exhausted:=true1965 else2156 Pile.Free; 2157 2158 if AttackLoc >= 0 then 2159 begin 2160 OldLoc := Loc; 2161 MoveResult := Unit_Move(uix, AttackLoc); 2162 Exhausted := (Loc = OldLoc) or 2163 ((MoveResult and (rMoreTurns or rUnitRemoved)) <> 0); 2164 if MoveResult and rLocationReached <> 0 then 2165 if Movement < 100 then 2166 Exhausted := True 2167 else 1966 2168 begin 1967 AttackResult:=Unit_Attack(uix,AttackLoc);1968 Exhausted:= ((AttackResult and rExecuted)=0)1969 or ((AttackResult and rUnitRemoved)<>0);2169 AttackResult := Unit_Attack(uix, AttackLoc); 2170 Exhausted := ((AttackResult and rExecuted) = 0) or 2171 ((AttackResult and rUnitRemoved) <> 0); 1970 2172 end; 1971 2173 end 1972 else Exhausted:=true; 1973 until Exhausted; 2174 else 2175 Exhausted := True; 2176 until Exhausted; 1974 2177 end; 1975 2178 end; // CheckAttack … … 1978 2181 procedure TAI.Patrol(uix: integer); 1979 2182 const 1980 DistanceScore=4;2183 DistanceScore = 4; 1981 2184 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;2185 PatrolScore, BestCount, PatrolLoc, TestLoc, NextLoc, TestTime, V8, 2186 TestScore, OldLoc, MoveResult, MoveStyle, NextTime, RecoverTurns: integer; 2187 Tile: cardinal; 2188 Exhausted, CaptureOnly: boolean; 2189 Adjacent: TVicinity8Loc; 2190 AdjacentUnknown: array[0..lxmax * lymax - 1] of shortint; 1988 2191 1989 2192 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 2193 with MyUnit[uix] do 2194 begin 2195 CaptureOnly := ((100 - Health) * Terrain[Map[Loc] and fTerrain].Defense > 60) and 2196 not (Map[Loc] and fTerrain in [fOcean, fShore, fArctic, fDesert]); 2197 MoveStyle := GetMyMoveStyle(mix, Health); 2198 repeat 2199 PatrolScore := -999999; 2200 PatrolLoc := -1; 2201 FillChar(AdjacentUnknown, MapSize, $FF); // -1, indicates tiles not checked yet 2202 Pile.Create(MapSize); 2203 Pile.Put(Loc, $800 - Movement); 2204 while Pile.Get(TestLoc, TestTime) do 2205 begin 2206 if (50 * $1000 - DistanceScore * TestTime <= PatrolScore) 2207 // assume a score of 50 is the best achievable 2208 or CaptureOnly and (TestTime >= $1000) then 2209 break; 2210 2211 TestScore := 0; 2212 Tile := Map[TestLoc]; 2213 AdjacentUnknown[TestLoc] := 0; 2214 2215 if ((Tile and fUnit) <> 0) and ((Tile and fOwned) = 0) then 2012 2216 // enemy unit 2013 2217 2014 else if ((Tile and fCity)<>0) and ((Tile and fOwned)=0) then2015 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 unknown2019 or (RO.Treaty[RO.Territory[TestLoc]] <trPeace)) then2020 TestScore:=40// unfriendly undefended city -- capture!2218 else if ((Tile and fCity) <> 0) and ((Tile and fOwned) = 0) then 2219 begin 2220 if ((Tile and fObserved) <> 0) and (MyModel[mix].Domain = dGround) and 2221 (MyModel[mix].Attack > 0) and ((RO.Territory[TestLoc] < 0) 2222 // happens only for unobserved cities of extinct tribes, new owner unknown 2223 or (RO.Treaty[RO.Territory[TestLoc]] < trPeace)) then 2224 TestScore := 40; // unfriendly undefended city -- capture! 2021 2225 end 2022 2226 2227 else 2228 begin // no enemy city or unit here 2229 V8_to_Loc(TestLoc, Adjacent); 2230 for V8 := 0 to 7 do 2231 begin 2232 NextLoc := Adjacent[V8]; 2233 if (NextLoc >= 0) and (AdjacentUnknown[NextLoc] < 0) then 2234 if Map[NextLoc] and fTerrain = fUNKNOWN then 2235 Inc(AdjacentUnknown[TestLoc]) 2236 else if Formation[NextLoc] = Formation[TestLoc] then 2237 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 2238 RecoverTurns, Map[TestLoc], Map[NextLoc], True) of 2239 csOk: 2240 Pile.Put(NextLoc, NextTime); 2241 csForbiddenTile: 2242 AdjacentUnknown[NextLoc] := 0; // don't check moving there again 2243 csCheckTerritory: 2244 if RO.Territory[NextLoc] = RO.Territory[TestLoc] then 2245 Pile.Put(NextLoc, NextTime); 2246 end; 2247 end; 2248 if not CaptureOnly then 2249 if AdjacentUnknown[TestLoc] > 0 then 2250 TestScore := 20 + AdjacentUnknown[TestLoc] 2251 else 2252 TestScore := (RO.Turn - RO.MapObservedLast[TestLoc]) div 16; 2253 end; // no enemy city or unit here 2254 2255 if TestScore > 0 then 2256 begin 2257 TestScore := TestScore * $1000 - DistanceScore * TestTime; 2258 if TestScore > PatrolScore then 2259 BestCount := 0; 2260 if TestScore >= PatrolScore then 2261 begin 2262 Inc(BestCount); 2263 if random(BestCount) = 0 then 2264 begin 2265 PatrolScore := TestScore; 2266 PatrolLoc := TestLoc; 2267 end; 2268 end; 2269 end; 2270 end; // while Pile.Get 2271 Pile.Free; 2272 2273 if PatrolLoc >= 0 then 2274 begin // attack/capture/discover/patrol task found, execute it 2275 OldLoc := Loc; 2276 MoveResult := Unit_Move(uix, PatrolLoc); 2277 Exhausted := (Loc = OldLoc) or 2278 ((MoveResult and (rMoreTurns or rUnitRemoved)) <> 0); 2279 end 2023 2280 else 2024 begin // no enemy city or unit here 2025 V8_to_Loc(TestLoc,Adjacent); 2026 for V8:=0 to 7 do 2027 begin 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 2058 begin 2059 PatrolScore:=TestScore; 2060 PatrolLoc:=TestLoc; 2061 end 2062 end; 2063 end 2064 end; // while Pile.Get 2065 Pile.Free; 2066 2067 if PatrolLoc>=0 then 2068 begin // attack/capture/discover/patrol task found, execute it 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; 2281 Exhausted := True; 2282 until Exhausted; 2076 2283 end; 2077 2284 end; // Patrol … … 2079 2286 procedure TAI.AttackAndPatrol; 2080 2287 const 2081 nAttackCatOrder=3;2082 AttackCatOrder: array[0..nAttackCatOrder-1] of integer=2083 (mctGroundAttacker, mctCruiser, mctGroundDefender);2288 nAttackCatOrder = 3; 2289 AttackCatOrder: array[0..nAttackCatOrder - 1] of integer = 2290 (mctGroundAttacker, mctCruiser, mctGroundDefender); 2084 2291 var 2085 iCat,uix,uix1: integer;2086 IsPatrolUnit,Fortified: boolean;2292 iCat, uix, uix1: integer; 2293 IsPatrolUnit, Fortified: boolean; 2087 2294 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 2295 for uix := 0 to RO.nUn - 1 do 2296 with MyUnit[uix] do // utilize militia 2297 if (Loc >= 0) and (mix = mixMilitia) and 2298 ((Formation[Loc] < 0) or (Formation[Loc] >= maxCOD) or 2299 (ContinentPresence[Formation[Loc]] and PresenceUnknown = 0)) then 2300 Unit_Disband(uix); 2301 2302 if RO.nEnemyUn > 0 then 2303 for iCat := 0 to nAttackCatOrder - 1 do 2304 for Fortified := False to True do 2305 for uix := RO.nUn - 1 downto 0 do 2306 with MyUnit[uix] do 2307 if (Loc >= 0) and (ModelCat[mix] = AttackCatOrder[iCat]) and 2308 (MyModel[mix].Attack > 0) and ((Flags and unFortified <> 0) = 2309 Fortified) then 2310 CheckAttack(uix); 2311 2312 fillchar(uixPatrol, sizeof(uixPatrol), $FF); 2313 for uix := 0 to RO.nUn - 1 do 2314 with MyUnit[uix], MyModel[mix] do 2315 if (Loc >= 0) and (Domain = dGround) and (Attack > 0) and 2316 (Speed >= 250) and (Map[Loc] and fTerrain >= fGrass) and 2317 (Formation[Loc] >= 0) and (Formation[Loc] < maxCOD) and 2318 ((uixPatrol[Formation[Loc]] < 0) or (MyUnit[uix].ID < 2319 MyUnit[uixPatrol[Formation[Loc]]].ID)) then 2320 uixPatrol[Formation[Loc]] := uix; 2321 2322 for uix := 0 to RO.nUn - 1 do 2323 with MyUnit[uix] do 2324 if Loc >= 0 then 2325 begin 2326 if mix = mixMilitia then 2327 if (RO.nUn < 3) and (RO.nCity = 1) or (Map[Loc] and fCity = 0) then 2328 IsPatrolUnit := True 2329 else 2330 begin // militia 2331 IsPatrolUnit := False; 2332 for uix1 := 0 to RO.nUn - 1 do 2333 if (uix1 <> uix) and (MyUnit[uix1].Loc = Loc) and 2334 (MyUnit[uix1].mix <> mixSettlers) then 2335 IsPatrolUnit := True; 2336 end 2337 else 2338 IsPatrolUnit := (mix = mixCruiser) or (Map[Loc] and fTerrain >= fGrass) and 2339 (Formation[Loc] >= 0) and (Formation[Loc] < maxCOD) and 2340 (uix = uixPatrol[Formation[Loc]]); 2341 if IsPatrolUnit then 2342 Patrol(uix); 2343 end; 2131 2344 end; // AttackAndPatrol 2132 2345 … … 2134 2347 function TAI.HavePort: boolean; 2135 2348 var 2136 V8, cix,AdjacentLoc,f: integer;2137 Adjacent: TVicinity8Loc;2349 V8, cix, AdjacentLoc, f: integer; 2350 Adjacent: TVicinity8Loc; 2138 2351 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 2352 Result := False; 2353 for cix := 0 to RO.nCity - 1 do 2354 with MyCity[cix] do 2355 if Loc >= 0 then 2356 begin 2357 V8_to_Loc(Loc, Adjacent); 2358 for V8 := 0 to 7 do 2359 begin 2360 AdjacentLoc := Adjacent[V8]; 2361 if (AdjacentLoc >= 0) and ((Map[AdjacentLoc] and fTerrain) < fGrass) then 2362 begin 2363 f := Formation[AdjacentLoc]; 2364 if (f >= 0) and (f < maxCOD) and (OceanPresence[f] and 2365 not (1 shl me) <> 0) then 2366 Result := True; 2367 end; 2368 end; 2369 end; 2154 2370 end; 2155 2371 … … 2157 2373 procedure TAI.SetCityProduction; 2158 2374 var 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; 2375 uix, cix, iix, dtr, V8, V21, NewImprovement, AdjacentLoc, MaxSettlers, 2376 maxcount, cixMilAcademy: integer; 2377 TerrType: cardinal; 2378 IsPort, IsNavalBase, NeedCruiser, CheckProd, Destructed, ProduceSettlers, 2379 ProduceMil: boolean; 2380 Adjacent: TVicinity8Loc; 2381 Radius: TVicinity21Loc; 2382 Report: TCityReport; 2383 HomeCount, CityProdRep: array[0..nCmax - 1] of integer; 2384 MilProdCity: array[0..nCmax - 1] of boolean; 2168 2385 2169 2386 procedure TryBuild(Improvement: integer); 2170 2387 begin 2171 if (NewImprovement=imTrGoods) // not already improvement of higher priority found2172 and (MyCity[cix].Built[Improvement]=0) // not built yet2173 and ((Imp[Improvement].Preq=preNone)2174 or (RO.Tech[Imp[Improvement].Preq]>=tsApplicable))2175 andCity_Improvable(cix, Improvement) then2176 NewImprovement:=Improvement;2388 if (NewImprovement = imTrGoods) // not already improvement of higher priority found 2389 and (MyCity[cix].Built[Improvement] = 0) // not built yet 2390 and ((Imp[Improvement].Preq = preNone) or 2391 (RO.Tech[Imp[Improvement].Preq] >= tsApplicable)) and 2392 City_Improvable(cix, Improvement) then 2393 NewImprovement := Improvement; 2177 2394 end; 2178 2395 2179 2396 procedure TryDestruct(Improvement: integer); 2180 2397 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); 2398 if Destructed or (MyCity[cix].Built[Improvement] = 0) then 2399 exit; 2400 if City_CurrentImprovementProject(cix) >= 0 then 2401 City_RebuildImprovement(cix, Improvement) 2402 else 2403 City_SellImprovement(cix, Improvement); 2185 2404 { if (CurrentImprovementProject>=0) 2186 2405 and (Imp[CurrentImprovementProject].Kind in [ikCommon,ikNatGlobal,ikNatLocal]) 2187 2406 and ((Imp[CurrentImprovementProject].Cost*3-Imp[Improvement].Cost*2) 2188 2407 *BuildCostMod[G.Difficulty[me]]>MyCity[cix].Prod*(12*3)) then} 2189 Destructed:=true2408 Destructed := True; 2190 2409 end; 2191 2410 2192 2411 function ChooseBuildModel(Cat: integer): integer; 2193 2412 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); 2413 Count, mix: integer; 2414 begin 2415 Count := 0; 2416 for mix := 0 to RO.nModel - 1 do 2417 if (ModelCat[mix] = Cat) and (ModelQuality[mix] >= 2418 ModelBestQuality[Cat] - MaxBuildWorseThanBestModel) then 2419 begin 2420 Inc(Count); 2421 if random(Count) = 0 then 2422 Result := mix; 2423 end; 2424 assert(Count > 0); 2202 2425 end; 2203 2426 … … 2205 2428 // find military production cities 2206 2429 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; 2430 cix, Total, d, Threshold, NewThreshold, Share, SharePlus, cixWorst: integer; 2431 begin 2432 fillchar(MilProdCity, RO.nCity, 0); 2433 GetCityProdPotential; 2434 for d := 0 to maxCOD - 1 do 2435 begin 2436 Total := 0; 2437 for cix := 0 to RO.nCity - 1 do 2438 with MyCity[cix] do 2439 if (Loc >= 0) and (District[Loc] = d) then 2440 Total := Total + CityResult[cix]; 2441 if Total = 0 then 2442 continue; // district does not exist 2443 2444 Share := 0; 2445 cixWorst := -1; 2446 for cix := 0 to RO.nCity - 1 do 2447 with MyCity[cix] do 2448 if (Loc >= 0) and (District[Loc] = d) and 2449 (Built[imBarracks] + Built[imMilAcademy] > 0) then 2450 begin 2451 MilProdCity[cix] := True; 2452 Inc(Share, CityResult[cix]); 2453 if (cixWorst < 0) or (CityResult[cix] < CityResult[cixWorst]) then 2454 cixWorst := cix; 2455 end; 2456 2457 Threshold := $FFFF; 2458 while (Threshold > 0) and (Share < Total * MilProdShare div 100) do 2459 begin 2460 NewThreshold := -1; 2461 for cix := 0 to RO.nCity - 1 do 2462 with MyCity[cix] do 2463 if (Loc >= 0) and (District[Loc] = d) and 2464 (Built[imBarracks] + Built[imMilAcademy] = 0) and 2465 (Built[imObservatory] = 0) and (CityResult[cix] < Threshold) and 2466 (CityResult[cix] >= NewThreshold) then 2467 if CityResult[cix] > NewThreshold then 2468 begin 2469 NewThreshold := CityResult[cix]; 2470 SharePlus := CityResult[cix]; 2471 end 2472 else 2473 Inc(SharePlus, CityResult[cix]); 2474 Threshold := NewThreshold; 2475 Inc(Share, SharePlus); 2476 end; 2477 2478 for cix := 0 to RO.nCity - 1 do 2479 with MyCity[cix] do 2480 if (Loc >= 0) and (District[Loc] = d) and 2481 (Built[imBarracks] + Built[imMilAcademy] = 0) and 2482 (CityResult[cix] >= Threshold) then 2483 MilProdCity[cix] := True; 2255 2484 { if (cixWorst>=0) 2256 2485 and (Share-CityResult[cixWorst]*2>=Total*MilProdShare div 100) then … … 2258 2487 end; 2259 2488 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 2489 // check best city for military academy 2490 cixMilAcademy := cixStateImp[imMilAcademy]; 2491 if cixStateImp[imPalace] >= 0 then 2492 begin 2493 d := District[MyCity[cixStateImp[imPalace]].Loc]; 2494 if (d >= 0) and (d < maxCOD) then 2495 begin 2496 cixMilAcademy := -1; 2497 for cix := 0 to RO.nCity - 1 do 2498 with MyCity[cix] do 2499 if (Loc >= 0) and (District[Loc] = d) and 2500 (Built[imObservatory] + Built[imPalace] = 0) and 2501 ((cixMilAcademy < 0) or (CityResult[cix] > CityResult[cixMilAcademy])) then 2502 cixMilAcademy := cix; 2503 end; 2504 if (cixMilAcademy >= 0) and (cixStateImp[imMilAcademy] >= 0) and 2505 (cixMilAcademy <> cixStateImp[imMilAcademy]) and 2506 (MyCity[cixStateImp[imMilAcademy]].Built[imObservatory] = 0) and 2507 (CityResult[cixMilAcademy] <= CityResult[cixStateImp[imMilAcademy]] * 2508 3 div 2) then 2509 cixMilAcademy := cixStateImp[imMilAcademy]; // because not so much better 2510 end; 2280 2511 end; 2281 2512 2282 2513 procedure ChangeHomeCities; 2283 2514 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: 2515 uix, NewHome, HomeSupport, NewHomeSupport, SingleSupport: integer; 2516 begin 2517 if RO.Government in [gAnarchy, gFundamentalism] then 2518 exit; 2519 for uix := 0 to RO.nUn - 1 do 2520 with MyUnit[uix] do 2521 if (Loc >= 0) and (Home >= 0) and (Map[Loc] and fCity <> 0) and 2522 (MyCity[Home].Loc <> Loc) and (MyModel[mix].Kind <> mkSettler) then 2523 begin 2524 City_FindMyCity(Loc, NewHome); 2525 case RO.Government of 2526 gDespotism: 2527 begin 2528 HomeSupport := HomeCount[Home] - MyCity[Home].Size; 2529 NewHomeSupport := HomeCount[NewHome] - MyCity[NewHome].Size; 2530 end; 2531 gMonarchy, gCommunism: 2532 begin 2533 HomeSupport := HomeCount[Home] - MyCity[Home].Size div 2; 2534 NewHomeSupport := HomeCount[NewHome] - MyCity[NewHome].Size div 2; 2535 end; 2536 else 2537 begin 2538 HomeSupport := HomeCount[Home]; 2539 NewHomeSupport := HomeCount[NewHome]; 2540 end; 2541 end; 2542 if HomeSupport > 0 then 2294 2543 begin 2295 HomeSupport:=HomeCount[Home]-MyCity[Home].Size; 2296 NewHomeSupport:=HomeCount[NewHome]-MyCity[NewHome].Size; 2544 if MyModel[mix].Flags and mdDoubleSupport = 0 then 2545 SingleSupport := 1 2546 else 2547 SingleSupport := 2; 2548 HomeSupport := HomeSupport - SingleSupport; 2549 NewHomeSupport := NewHomeSupport + SingleSupport; 2550 if HomeSupport < 0 then 2551 HomeSupport := 0; 2552 if NewHomeSupport < 0 then 2553 NewHomeSupport := 0; 2554 if (NewHomeSupport <= 0) or (CityProdRep[Home] - 2555 HomeSupport <= CityProdRep[NewHome] - NewHomeSupport) then 2556 begin 2557 Dec(HomeCount[Home], SingleSupport); 2558 Inc(HomeCount[NewHome], SingleSupport); 2559 Unit_SetHomeHere(uix); 2560 end; 2297 2561 end; 2298 gMonarchy, gCommunism: 2562 end; 2563 end; 2564 2565 begin 2566 fillchar(HomeCount, 4 * RO.nCity, 0); 2567 for uix := 0 to RO.nUn - 1 do 2568 with MyUnit[uix] do 2569 if (Loc >= 0) and (Home >= 0) then 2570 if MyModel[mix].Flags and mdDoubleSupport = 0 then 2571 Inc(HomeCount[Home]) 2572 else 2573 Inc(HomeCount[Home], 2); 2574 2575 NominateMilProdCities; 2576 2577 for cix := 0 to RO.nCity - 1 do 2578 with MyCity[cix] do 2579 if (Loc >= 0) and (Flags and chCaptured = 0) and (District[Loc] >= 0) then 2580 begin 2581 if size < 4 then 2582 City_OptimizeTiles(cix, rwMaxGrowth) 2583 else 2584 City_OptimizeTiles(cix, rwForceProd); 2585 2586 City_GetReport(cix, Report); 2587 CityProdRep[cix] := Report.ProdRep; 2588 2589 Destructed := False; 2590 CheckProd := (RO.Turn = 0) or ((Flags and chProduction) <> 2591 0) // city production complete 2592 or not City_HasProject(cix); 2593 if not CheckProd then 2594 begin // check whether producing double state improvement or wonder 2595 iix := City_CurrentImprovementProject(cix); 2596 if (iix >= 0) and (((Imp[iix].Kind in [ikNatLocal, ikNatGlobal]) and 2597 (RO.NatBuilt[iix] > 0)) or ((Imp[iix].Kind = ikWonder) and 2598 (RO.Wonder[iix].CityID <> -1))) then 2599 CheckProd := True; 2600 end; 2601 if CheckProd then 2602 begin // check production 2603 IsPort := False; 2604 IsNavalBase := False; 2605 NeedCruiser := False; 2606 V8_to_Loc(Loc, Adjacent); 2607 for V8 := 0 to 7 do 2299 2608 begin 2300 HomeSupport:=HomeCount[Home]-MyCity[Home].Size div 2; 2301 NewHomeSupport:=HomeCount[NewHome]-MyCity[NewHome].Size div 2; 2609 AdjacentLoc := Adjacent[V8]; 2610 if (AdjacentLoc >= 0) and ((Map[AdjacentLoc] and fTerrain) < fGrass) then 2611 begin 2612 IsPort := True; // shore tile at adjacent location -- city is port! 2613 if (Formation[AdjacentLoc] >= 0) and 2614 (Formation[AdjacentLoc] < maxCOD) and 2615 (OceanPresence[Formation[AdjacentLoc]] and WarNations <> 0) then 2616 begin 2617 IsNavalBase := True; 2618 if (1 shl Formation[AdjacentLoc]) and OceanWithShip = 0 then 2619 NeedCruiser := True; 2620 end; 2621 end; 2302 2622 end; 2303 else 2623 2624 if RO.Turn = 0 then 2304 2625 begin 2305 HomeSupport:=HomeCount[Home]; 2306 NewHomeSupport:=HomeCount[NewHome]; 2626 NewImprovement := -1; 2627 City_StartUnitProduction(cix, mixMilitia); // militia 2628 end 2629 else 2630 NewImprovement := imTrGoods; 2631 2632 dtr := District[Loc]; // formation of city 2633 2634 if NewImprovement = imTrGoods then 2635 begin 2636 if (Built[imPalace] + Built[imCourt] + Built[imTownHall] = 0) then 2637 TryBuild(imTownHall); 2307 2638 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 2639 2640 if (NewImprovement = imTrGoods) and (RO.Government = gDespotism) and 2641 (Report.Support = 0) then 2642 begin // produce town guard 2643 NewImprovement := -1; 2644 City_StartUnitProduction(cix, mixTownGuard); 2645 end; 2646 2647 if NewImprovement = imTrGoods then 2319 2648 begin 2320 dec(HomeCount[Home],SingleSupport); 2321 inc(HomeCount[NewHome],SingleSupport); 2322 Unit_SetHomeHere(uix) 2323 end 2324 end 2325 end 2326 end; 2327 2328 begin 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 2360 begin // check production 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 2649 if RO.Government = gDespotism then 2650 maxcount := Size 2651 else 2652 maxcount := Size div 2; 2653 2654 if IsResearched(adRailroad) and (mixSettlers = 2655 0) // better wait for engineers 2656 or (Built[imColosseum] + Built[imObservatory] > 0) then 2657 MaxSettlers := 1 2658 else 2659 MaxSettlers := (Size + 2) div 6; 2660 ProduceSettlers := 2661 (HomeCount[cix] < maxcount + Size div 2) and 2662 ((Report.Eaten - Size * 2) div SettlerFood[RO.Government] < 2663 MaxSettlers) and ((dtr < 0) or (dtr >= maxCOD) or 2664 (SettlerSurplus[dtr] <= 0)); 2665 2666 ProduceMil := (HomeCount[cix] < maxcount + Size div 2) and 2667 (Built[imBarracks] + Built[imMilAcademy] > 0) and 2668 ((ModelBestQuality[mctGroundDefender] > 0) or 2669 (ModelBestQuality[mctGroundAttacker] > 0)) and 2670 ((dtr < maxCOD) and ((UnitLack[dtr, mctGroundAttacker] > 0) or 2671 (UnitLack[dtr, mctGroundDefender] > 0)) or (HomeCount[cix] < maxcount)); 2672 2673 if ProduceMil or not ProduceSettlers and (HomeCount[cix] < maxcount) then 2674 begin 2675 NewImprovement := -1; 2676 if (dtr >= maxCOD) or 2677 (ModelBestQuality[mctGroundDefender] = 0) or 2678 (UnitLack[dtr, mctGroundAttacker] >= 2679 UnitLack[dtr, mctGroundDefender]) then 2680 City_StartUnitProduction(cix, ChooseBuildModel(mctGroundAttacker)) 2681 else 2682 City_StartUnitProduction(cix, ChooseBuildModel(mctGroundDefender)); 2683 end 2684 else if ProduceSettlers then 2685 begin 2686 NewImprovement := -1; 2687 City_StartUnitProduction(cix, mixSettlers); 2688 end; 2689 end; 2690 2691 if NewImprovement >= 0 then 2692 begin // produce improvement 2693 if (RO.Turn >= 40) and (Report.Happy * 2 <= Size) and 2694 (Built[imColosseum] = 0) then 2695 TryBuild(imTemple); 2696 if cix = cixMilAcademy then 2697 TryBuild(imMilAcademy) 2698 else if ((Built[imPalace] > 0) or MilProdCity[cix] and 2699 (Built[imTemple] > 0)) and (Built[imObservatory] = 0) then 2700 TryBuild(imBarracks); 2701 if Report.Trade - Report.Corruption >= 11 then 2702 TryBuild(imLibrary); 2703 if Report.Trade - Report.Corruption >= 11 then 2704 TryBuild(imMarket); 2705 if (Report.Trade - Report.Corruption >= 11) and (Report.Happy >= 4) then 2706 TryBuild(imUniversity); 2707 if (Built[imPalace] > 0) and (Report.Trade - Report.Corruption >= 11) and 2708 (Report.Happy >= 4) and (RO.NatBuilt[imObservatory] = 0) then 2709 TryBuild(imObservatory); // always build observatory in capital 2710 if (Report.Trade - Report.Corruption >= 15) and (Report.Happy >= 4) then 2711 TryBuild(imResLab); 2712 if (Size >= 9) and (Built[imPalace] + Built[imCourt] > 0) then 2713 TryBuild(imHighways); 2714 if (RO.Government <> gDespotism) and (Report.Happy * 2 <= Size) and 2715 (Built[imCathedral] + Built[imTheater] + Built[imColosseum] = 0) then 2716 begin 2717 TryBuild(imCathedral); 2718 TryBuild(imTheater); 2719 end; 2720 if (RO.Government <> gDespotism) and (Size >= NeedAqueductSize) then 2721 TryBuild(imAqueduct); 2722 if (Built[imColosseum] + Built[imObservatory] > 0) and 2723 (Size >= NeedSewerSize) then 2724 TryBuild(imSewer); 2725 if (RO.NatBuilt[imGrWall] = 0) and 2726 (Built[imObservatory] + Built[imMilAcademy] = 0) and 2727 (RO.nCity >= 6) and (cixStateImp[imPalace] >= 0) and 2728 (Formation[Loc] = Formation[MyCity[cixStateImp[imPalace]].Loc]) and 2729 (Report.ProdRep - Report.Support >= 6) then 2730 TryBuild(imGrWall); 2731 // if Map[Loc] and fGrWall=0 then 2732 // TryBuild(imWalls); 2733 // if IsNavalBase then 2734 // TryBuild(imCoastalFort); 2735 if (RO.NatBuilt[imSpacePort] = 0) and 2736 (Built[imObservatory] + Built[imMilAcademy] = 0) and 2737 (Report.ProdRep - Report.Support >= 10) then 2738 TryBuild(imSpacePort); 2739 if Report.ProdRep >= 8 then 2740 TryBuild(imFactory); 2741 if Report.ProdRep >= 12 then 2742 TryBuild(imMfgPlant); 2743 if IsPort then 2744 if Size > 8 then 2745 TryBuild(imHarbor) 2746 else if (Built[imHarbor] = 0) and (Size > 4) and 2747 ((Size and 1 <> 0) and (Report.Happy * 2 > Size) or 2748 (Built[imColosseum] > 0)) then 2749 begin // check building harbor 2750 V21_to_Loc(Loc, Radius); 2751 for V21 := 1 to 26 do // city is in growth mode - using any 1-food tile? 2752 if Tiles and (1 shl V21) <> 0 then 2753 begin 2754 TerrType := Map[Radius[V21]] and (fTerrain or fSpecial); 2755 if TerrType in [fDesert, fTundra, fSwamp, fForest, 2756 fHills, fMountains] then 2757 begin 2758 TryBuild(imHarbor); 2759 break; 2760 end; 2761 end; 2762 end; 2763 if (Size <= 10) and (Report.FoodRep - Report.Eaten < 2) and 2764 (Report.Happy * 2 >= Size + 2) then 2765 TryBuild(imSuperMarket); 2766 2767 // less important 2768 if (Built[imPalace] > 0) and (RO.NatBuilt[imColosseum] = 0) and 2769 (Size >= 10) then 2770 TryBuild(imColosseum); // always build colosseum in capital 2771 if (Built[imPalace] + Built[imCourt] = 0) and 2772 ((Report.Corruption > 2) or IsResearched(Imp[imHighways].Preq)) then 2773 TryBuild(imCourt); // replace courthouse 2774 if Report.PollRep >= 15 then 2775 TryBuild(imRecycling); 2776 if (Report.Trade - Report.Corruption >= 11) and 2777 (RO.Money < TotalPopulation[me] * 2) then 2778 TryBuild(imBank); 2779 if (RO.NatBuilt[imStockEx] = 0) and 2780 (Built[imObservatory] + Built[imMilAcademy] = 0) and 2781 (Report.ProdRep - Report.Support >= 8) then 2782 TryBuild(imStockEx); 2783 2784 // every improvement checked -- start production now 2785 if NewImprovement <> imTrGoods then 2786 begin 2787 if City_StartImprovement(cix, NewImprovement) < rExecuted then 2788 NewImprovement := imTrGoods; 2789 end; 2790 if (NewImprovement = imTrGoods) and (RO.Turn and $F = 0) then 2791 begin // try colony ship parts 2792 NewImprovement := imShipComp; 2793 while (NewImprovement <= imShipHab) and 2794 ((RO.Tech[Imp[NewImprovement].Preq] < 0) or 2795 (City_StartImprovement(cix, NewImprovement) < rExecuted)) do 2796 Inc(NewImprovement); 2797 if NewImprovement > imShipHab then 2798 NewImprovement := imTrGoods; 2799 end; 2800 end; 2801 2802 if (NewImprovement = imTrGoods) and NeedCruiser and 2803 (mixCruiser >= 0) and (Project and (cpImp or cpIndex) <> mixCruiser) and 2804 (Report.ProdRep - Report.Support >= 6) then 2369 2805 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 2379 end; 2380 2381 if RO.Turn=0 then 2382 begin 2383 NewImprovement:=-1; 2384 City_StartUnitProduction(cix,mixMilitia); // militia 2385 end 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 2426 begin 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); 2806 NewImprovement := -1; 2807 City_StartUnitProduction(cix, mixCruiser); 2470 2808 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 2532 end; 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; 2809 2810 if (NewImprovement = imTrGoods) and City_HasProject(cix) then 2811 City_StopProduction(cix); 2812 2813 // rebuild imps no longer needed 2814 if (RO.TaxRate = 0) and (RO.Money >= TotalPopulation[me] * 4) then 2815 TryDestruct(imBank) 2816 else if Report.Happy * 2 >= Size + 6 then 2817 TryDestruct(imTheater) 2818 else if Report.Happy * 2 >= Size + 4 then 2819 TryDestruct(imTemple); 2820 end; 2821 2822 // rebuild imps no longer needed, no report needed 2823 if (Built[imObservatory] > 0) or (Project and (cpImp or cpIndex) = 2824 cpImp or imObservatory) 2825 {or not MilProdCity[cix]} then 2826 TryDestruct(imBarracks); 2827 if Map[Loc] and fGrWall <> 0 then 2828 TryDestruct(imWalls); 2829 if Built[imColosseum] > 0 then 2830 begin 2831 TryDestruct(imTheater); 2832 TryDestruct(imCathedral); 2833 TryDestruct(imTemple); 2834 end; 2835 end; 2836 2837 ChangeHomeCities; 2580 2838 end; // SetCityProduction 2581 2839 … … 2583 2841 function TAI.ChooseGovernment: integer; 2584 2842 begin 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 2843 if Data.BehaviorFlags and bBarbarina <> 0 then 2844 if IsResearched(adTheology) then 2845 Result := gFundamentalism 2846 else 2847 Result := gDespotism 2848 else if IsResearched(adDemocracy) then 2849 Result := gDemocracy //!!! 2850 else if IsResearched(adTheRepublic) then 2851 Result := gRepublic 2852 else if IsResearched(adMonarchy) then 2853 Result := gMonarchy 2854 else 2855 Result := gDespotism; 2595 2856 end; 2596 2857 … … 2602 2863 function TAI.MostWanted(Nation, adGiveAway: integer): integer; 2603 2864 var 2604 ad: integer;2865 ad: integer; 2605 2866 begin 2606 result:=-1;2607 if RO.Tech[adGiveAway]>=tsApplicable then2608 if (adGiveAway=adTheRepublic) and (Data.BehaviorFlags and bGender=bFemale)2609 and (RO.Tech[adTheology]<tsSeen) then2610 begin 2611 if RO.EnemyReport[Nation].Tech[adTheology]>=tsApplicable then2612 result:=adTheology2867 Result := -1; 2868 if RO.Tech[adGiveAway] >= tsApplicable then 2869 if (adGiveAway = adTheRepublic) and (Data.BehaviorFlags and bGender = bFemale) and 2870 (RO.Tech[adTheology] < tsSeen) then 2871 begin 2872 if RO.EnemyReport[Nation].Tech[adTheology] >= tsApplicable then 2873 Result := adTheology; 2613 2874 end 2614 else for ad:=0 to nAdv-5 do // no future techs2615 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 opponent2622 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)) then2629 result:=ad2875 else 2876 for ad := 0 to nAdv - 5 do // no future techs 2877 if (AdvanceValue[ad] > 0) and (RO.Tech[ad] < tsSeen) and 2878 (ad <> RO.ResearchTech) and (RO.EnemyReport[Nation].Tech[ad] >= 2879 tsApplicable) and ((Advancedness[adGiveAway] <= Advancedness[ad] + 2880 AdvanceValue[ad] shr 8 + Compromise) or (adGiveAway = adScience) and 2881 (Nation = Data.TheologyPartner)) and 2882 ((Result < 0) or ((Advancedness[adGiveAway] + Compromise >= 2883 Advancedness[ad]) // acceptable for opponent 2884 or (ad = adScience)) and (AdvanceValue[ad] > AdvanceValue[Result]) or 2885 (Result <> adScience) and (Advancedness[adGiveAway] + 2886 Compromise < Advancedness[Result]) and (Advancedness[ad] < 2887 Advancedness[Result])) and ((ad <> adTheRepublic) or 2888 (Data.BehaviorFlags and bGender = bFemale) or 2889 (RO.EnemyReport[Nation].Tech[adTheology] >= tsSeen)) then 2890 Result := ad; 2630 2891 end; 2631 2892 2632 2893 procedure TAI.FindBestTrade(Nation: integer; var adWanted, adGiveAway: integer); 2633 2894 var 2634 i,ad,ead,adTestGiveAway: integer;2895 i, ad, ead, adTestGiveAway: integer; 2635 2896 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 2897 adWanted := -1; 2898 adGiveAway := -1; 2899 for ead := 0 to nAdv - 5 do // no future techs 2900 if (AdvanceValue[ead] >= $100) and (RO.Tech[ead] < tsSeen) and 2901 (ead <> RO.ResearchTech) and (RO.EnemyReport[Nation].Tech[ead] >= tsApplicable) and 2902 ((adWanted < 0) or (AdvanceValue[ead] > AdvanceValue[adWanted])) then 2903 begin 2904 adTestGiveAway := -1; 2905 for i := 0 to nRequestedTechs - 1 do 2906 if (Data.RequestedTechs[i] >= 0) and 2907 (Data.RequestedTechs[i] and $FFFF = Nation shl 8 + ead) then 2908 adTestGiveAway := -2; // already requested before 2909 if adTestGiveAway = -1 then 2910 begin 2911 for ad := 0 to nAdv - 5 do // no future techs 2912 if (RO.Tech[ad] >= tsApplicable) and 2913 (ad <> RO.EnemyReport[Nation].ResearchTech) and 2914 (RO.EnemyReport[Nation].Tech[ad] < tsSeen) and 2915 ((Advancedness[ad] + Compromise >= Advancedness[ead]) or 2916 (ead = adScience)) and (Advancedness[ad] <= Advancedness[ead] + 2917 AdvanceValue[ead] shr 8 + Compromise) and 2918 ((adTestGiveAway < 0) or (Advancedness[ad] < 2919 Advancedness[adTestGiveAway])) then 2920 adTestGiveAway := ad; 2921 if adTestGiveAway >= 0 then 2922 begin 2923 adWanted := ead; 2924 adGiveAway := adTestGiveAway; 2925 end; 2926 end; 2665 2927 end; 2666 2928 end; … … 2669 2931 function TAI.WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; 2670 2932 var 2671 p1,count,adWanted,adGiveAway: integer;2933 p1, Count, adWanted, adGiveAway: integer; 2672 2934 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; 2935 if Data.BehaviorFlags and bBarbarina = bBarbarina then 2936 begin 2937 Result := Barbarina_WantNegotiation(Nation, NegoTime); 2938 exit; 2939 end; 2940 2941 if RO.Treaty[Nation] < trPeace then 2942 begin 2943 if Data.BehaviorFlags and bBarbarina <> 0 then 2944 begin 2945 Result := False; 2946 exit; 2947 end; 2948 Count := 0; 2949 for p1 := 0 to nPl - 1 do 2950 if (p1 <> me) and (1 shl p1 and RO.Alive <> 0) and (RO.Treaty[p1] >= trPeace) then 2951 Inc(Count); 2952 if Count >= 3 then // enough peace made 2953 begin 2954 Result := False; 2955 exit; 2956 end; 2957 end; 2958 2959 NegoCause := Routine; 2960 case NegoTime of 2961 EnemyCalled: 2962 Result := True; 2963 EndOfTurn: 2964 if (Data.RejectTurn[suContact, Nation] >= 0) and 2965 (Data.RejectTurn[suContact, Nation] + WaitAfterReject >= RO.Turn) then 2966 Result := False 2967 else if RO.Treaty[Nation] < trPeace then 2968 Result := (Data.RejectTurn[suPeace, Nation] < 0) or 2969 (Data.RejectTurn[suPeace, Nation] + WaitAfterReject < RO.Turn) 2970 else if RO.Treaty[Nation] = trPeace then 2971 Result := (Data.BehaviorFlags and bBarbarina = 0) and 2972 ((Data.RejectTurn[suFriendly, Nation] < 0) or 2973 (Data.RejectTurn[suFriendly, Nation] + WaitAfterReject < RO.Turn)) 2974 else 2975 begin 2976 FindBestTrade(Nation, adWanted, adGiveAway); 2977 Result := adWanted >= 0; 2978 end; 2979 BeginOfTurn: 2980 if (Data.RejectTurn[suContact, Nation] >= 0) and 2981 (Data.RejectTurn[suContact, Nation] + WaitAfterReject >= RO.Turn) then 2982 Result := False 2983 else if (Data.BehaviorFlags and bGender = bMale) and 2984 Barbarina_WantCheckNegotiation(Nation) then 2985 begin 2986 NegoCause := CheckBarbarina; 2987 Result := True; 2988 end 2989 else 2990 Result := False; 2715 2991 end; 2716 2992 end; … … 2718 2994 procedure TAI.DoNegotiation; 2719 2995 var 2720 i, adWanted, adGiveAway, adToGet, Slot: integer;2721 BuildFreeOffer: boolean;2996 i, adWanted, adGiveAway, adToGet, Slot: integer; 2997 BuildFreeOffer: boolean; 2722 2998 begin 2723 if MyLastAction=scDipOffer then2724 if OppoAction=scDipAccept then2999 if MyLastAction = scDipOffer then 3000 if OppoAction = scDipAccept then 2725 3001 begin // evaluate accepted offers 2726 AdvanceValuesSet:=false;2727 if (MyLastOffer.nDeliver=1) and (MyLastOffer.nCost>0)2728 and (MyLastOffer.Price[1]=opTech+adTheology) then2729 Data.TheologyPartner:=Opponent;3002 AdvanceValuesSet := False; 3003 if (MyLastOffer.nDeliver = 1) and (MyLastOffer.nCost > 0) and 3004 (MyLastOffer.Price[1] = opTech + adTheology) then 3005 Data.TheologyPartner := Opponent; 2730 3006 end 2731 else3007 else 2732 3008 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 3009 if MyLastOffer.nDeliver + MyLastOffer.nCost = 1 then 3010 if MyLastOffer.Price[0] = opTreaty + trPeace then 3011 Data.RejectTurn[suPeace, Opponent] := RO.Turn 3012 else if MyLastOffer.Price[0] = opTreaty + trFriendlyContact then 3013 Data.RejectTurn[suFriendly, Opponent] := RO.Turn; 3014 end; 3015 if OppoAction = scDipBreak then 3016 Data.RejectTurn[suContact, Opponent] := RO.Turn 3017 else if OppoAction = scDipCancelTreaty then 3018 begin 3019 case RO.Treaty[Opponent] of 3020 trNone: Data.RejectTurn[suPeace, Opponent] := RO.Turn; 3021 trPeace: Data.RejectTurn[suFriendly, Opponent] := RO.Turn; 3022 end; 3023 end; 3024 3025 if Data.BehaviorFlags and bBarbarina = bBarbarina then 3026 begin 3027 Barbarina_DoNegotiation; 3028 exit; 3029 end; 3030 3031 if NegoCause = CheckBarbarina then 3032 begin 3033 Barbarina_DoCheckNegotiation; 3034 exit; 3035 end; 3036 3037 SetAdvanceValues; // in case no turn played after loading this game 3038 3039 BuildFreeOffer := False; 3040 if (OppoAction = scDipStart) or (OppoAction = scDipAccept) then 3041 BuildFreeOffer := True 3042 else if (OppoAction = scDipOffer) and (OppoOffer.nDeliver + OppoOffer.nCost = 0) then 3043 BuildFreeOffer := True 3044 else if OppoAction = scDipOffer then 3045 begin 3046 if (Data.BehaviorFlags and bBarbarina = 0) and 3047 (OppoOffer.nDeliver + OppoOffer.nCost = 1) and 3048 (OppoOffer.Price[0] and opMask = opTreaty) and 3049 (integer(OppoOffer.Price[0] - opTreaty) > RO.Treaty[Opponent]) and 3050 ((OppoOffer.Price[0] - opTreaty < trAlliance) or 3051 (RO.Tech[adScience] >= tsSeen)) then 3052 MyAction := scDipAccept // accept all treaties 3053 else if (RO.Treaty[Opponent] >= trPeace) and (OppoOffer.nDeliver = 1) and 3054 (OppoOffer.Price[0] and $FFFF0000 = opCivilReport + cardinal(Opponent) shl 16) and 3055 (OppoOffer.nCost = 1) and (OppoOffer.Price[1] and $FFFF0000 = 3056 opCivilReport + cardinal(me) shl 16) then 3057 MyAction := scDipAccept // accept exchange of civil reports 3058 else if (OppoOffer.nDeliver = 1) and (OppoOffer.nCost = 1) and 3059 (OppoOffer.Price[1] and opMask = opTech) then 2778 3060 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 3061 BuildFreeOffer := True; 3062 adGiveAway := OppoOffer.Price[1] - opTech; 3063 if (OppoOffer.Price[0] and opMask = opTech) and 3064 (MyLastAction = scDipOffer) and (MyLastOffer.nDeliver = 1) and 3065 (MyLastOffer.nCost = 1) and (OppoOffer.Price[0] = MyLastOffer.Price[1]) then 2785 3066 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; 3067 adToGet := OppoOffer.Price[0] - opTech; 3068 if (adGiveAway = adTheRepublic) and (Data.BehaviorFlags and 3069 bGender = bFemale) and (RO.Tech[adTheology] < tsSeen) then 3070 begin 3071 if adToGet = adTheology then 3072 MyAction := scDipAccept; 2791 3073 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)) then2797 MyAction:=scDipAccept3074 else if (RO.Tech[adGiveAway] >= tsApplicable) and 3075 (RO.Tech[adToGet] < tsSeen) and (AdvanceValue[adToGet] > 0) and 3076 ((Advancedness[adGiveAway] <= Advancedness[adToGet] + 3077 AdvanceValue[adToGet] shr 8 + Compromise) or (adGiveAway = adScience) and 3078 (Opponent = Data.TheologyPartner)) then 3079 MyAction := scDipAccept; 2798 3080 end 2799 else if (OppoOffer.Price[0] and opMask=opChoose)2800 or (OppoOffer.Price[0] and opMask=opTech) then3081 else if (OppoOffer.Price[0] and opMask = opChoose) or 3082 (OppoOffer.Price[0] and opMask = opTech) then 2801 3083 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) then2805 MyAction:=scDipAccept // opponent's offer is already perfect2806 else if adWanted>=0 then3084 adWanted := MostWanted(Opponent, OppoOffer.Price[1] - opTech); 3085 if (OppoOffer.Price[0] and opMask = opTech) and 3086 (cardinal(adWanted) = OppoOffer.Price[0] - opTech) then 3087 MyAction := scDipAccept // opponent's offer is already perfect 3088 else if adWanted >= 0 then 2807 3089 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 3090 MyOffer.nDeliver := 1; 3091 MyOffer.nCost := 1; 3092 MyOffer.Price[0] := OppoOffer.Price[1]; 3093 MyOffer.Price[1] := opTech + adWanted; 3094 MyAction := scDipOffer; 3095 BuildFreeOffer := False; 3096 end; 3097 end; 3098 if MyAction = scDipAccept then 3099 BuildFreeOffer := False; 2817 3100 end 2818 else BuildFreeOffer:=true2819 end;2820 if (MyAction=scDipAccept) and (OppoAction=scDipOffer) then 2821 begin2822 AdvanceValuesSet:=false;2823 if (OppoOffer.nDeliver>0) and (OppoOffer.Price[0]=opTech+adTheology) then2824 Data.TheologyPartner:=Opponent2825 end;2826 2827 if BuildFreeOffer then 2828 begin2829 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)) then2833 begin 2834 MyOffer.nDeliver:=1;2835 MyOffer.nCost:=0;2836 MyOffer.Price[0]:=opTreaty+trPeace;2837 MyAction:=scDipOffer3101 else 3102 BuildFreeOffer := True; 3103 end; 3104 if (MyAction = scDipAccept) and (OppoAction = scDipOffer) then 3105 begin 3106 AdvanceValuesSet := False; 3107 if (OppoOffer.nDeliver > 0) and (OppoOffer.Price[0] = opTech + adTheology) then 3108 Data.TheologyPartner := Opponent; 3109 end; 3110 3111 if BuildFreeOffer then 3112 begin 3113 if (Data.BehaviorFlags and bBarbarina = 0) and (RO.Treaty[Opponent] < trPeace) and 3114 ((Data.RejectTurn[suPeace, Opponent] < 0) or 3115 (Data.RejectTurn[suPeace, Opponent] + WaitAfterReject < RO.Turn)) then 3116 begin 3117 MyOffer.nDeliver := 1; 3118 MyOffer.nCost := 0; 3119 MyOffer.Price[0] := opTreaty + trPeace; 3120 MyAction := scDipOffer; 2838 3121 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)) then2843 begin 2844 MyOffer.nDeliver:=1;2845 MyOffer.nCost:=0;2846 MyOffer.Price[0]:=opTreaty+trFriendlyContact;2847 MyAction:=scDipOffer3122 else if (Data.BehaviorFlags and bBarbarina = 0) and 3123 (RO.Treaty[Opponent] = trPeace) and 3124 ((Data.RejectTurn[suFriendly, Opponent] < 0) or 3125 (Data.RejectTurn[suFriendly, Opponent] + WaitAfterReject < RO.Turn)) then 3126 begin 3127 MyOffer.nDeliver := 1; 3128 MyOffer.nCost := 0; 3129 MyOffer.Price[0] := opTreaty + trFriendlyContact; 3130 MyAction := scDipOffer; 2848 3131 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 3132 else 3133 begin 3134 FindBestTrade(Opponent, adWanted, adGiveAway); 3135 if adWanted >= 0 then 3136 begin 3137 MyOffer.nDeliver := 1; 3138 MyOffer.nCost := 1; 3139 MyOffer.Price[0] := opTech + adGiveAway; 3140 MyOffer.Price[1] := opTech + adWanted; 3141 MyAction := scDipOffer; 3142 for i := 0 to nRequestedTechs - 1 do 3143 if Data.RequestedTechs[i] < 0 then 3144 begin 3145 Slot := i; 3146 break; 3147 end 3148 else if (i = 0) or (Data.RequestedTechs[i] shr 16 < 3149 Data.RequestedTechs[Slot] shr 16) then // find most outdated entry 3150 Slot := i; 3151 Data.RequestedTechs[Slot] := RO.Turn shl 16 + Opponent shl 8 + adWanted; 3152 end; 3153 end; 2868 3154 end; 2869 3155 end; // Negotiation … … 2871 3157 2872 3158 procedure SetLeaveOutValue; 3159 2873 3160 procedure Process(ad: integer); 2874 3161 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; 3162 i: integer; 3163 begin 3164 if LeaveOutValue[ad] < 0 then 3165 begin 3166 LeaveOutValue[ad] := 0; 3167 for i := 0 to 1 do 3168 if AdvPreq[ad, i] >= 0 then 3169 begin 3170 Process(AdvPreq[ad, i]); 3171 if AdvPreq[ad, i] in LeaveOutTechs then 3172 Inc(LeaveOutValue[ad], LeaveOutValue[AdvPreq[ad, i]] + 1); 3173 end; 3174 end; 3175 end; 3176 2888 3177 var 2889 ad: integer;3178 ad: integer; 2890 3179 begin 2891 FillChar(LeaveOutValue,SizeOf(LeaveOutValue),$FF); 2892 for ad:=0 to nAdv-5 do Process(ad); 3180 FillChar(LeaveOutValue, SizeOf(LeaveOutValue), $FF); 3181 for ad := 0 to nAdv - 5 do 3182 Process(ad); 2893 3183 end; 2894 3184 2895 3185 2896 3186 initialization 2897 RWDataSize:=sizeof(TPersistentData);2898 SetLeaveOutValue;3187 RWDataSize := sizeof(TPersistentData); 3188 SetLeaveOutValue; 2899 3189 2900 3190 end. 2901 -
branches/highdpi/AI/StdAI/Barbarina.pas
r210 r303 7 7 {$IFDEF DEBUG}SysUtils,{$ENDIF} // necessary for debug exceptions 8 8 {$IFDEF DEBUG}Names,{$ENDIF} 9 Protocol, ToolAI, CustomAI; 10 9 Protocol, ToolAI, CustomAI; 11 10 12 11 const 13 nModelCategory=4; 14 ctGroundSlow=0; ctGroundFast=1; ctSeaTrans=2; ctSeaArt=3; 15 16 maxCOD=256; 17 18 maxModern=16; 19 // maximum number of modern resources of one type being managed 20 // (for designed maps only, number is 2 in standard game) 12 nModelCategory = 4; 13 ctGroundSlow = 0; 14 ctGroundFast = 1; 15 ctSeaTrans = 2; 16 ctSeaArt = 3; 17 18 maxCOD = 256; 19 20 maxModern = 16; 21 // maximum number of modern resources of one type being managed 22 // (for designed maps only, number is 2 in standard game) 21 23 22 24 23 25 type 24 TColonyShipPlan = array[0..nShipPart-1] of record25 cixProducing: integer;26 LocResource: array[0..maxModern-1] of integer;27 nLocResource: integer;28 LocFoundCity: array[0..maxModern-1] of integer;29 nLocFoundCity: integer;26 TColonyShipPlan = array[0..nShipPart - 1] of record 27 cixProducing: integer; 28 LocResource: array[0..maxModern - 1] of integer; 29 nLocResource: integer; 30 LocFoundCity: array[0..maxModern - 1] of integer; 31 nLocFoundCity: integer; 30 32 end; 31 33 32 TBarbarina = class(TToolAI)33 constructor Create(Nation: integer); override;34 35 protected36 ColonyShipPlan: TColonyShipPlan;37 function Barbarina_GoHidden: boolean; // whether we should prepare for barbarina mode38 function Barbarina_Go: boolean; // whether we should switch to barbarina mode now39 procedure Barbarina_DoTurn;40 procedure Barbarina_SetCityProduction;41 function Barbarina_ChooseResearchAdvance: integer;42 function Barbarina_WantCheckNegotiation(Nation: integer): boolean;43 procedure Barbarina_DoCheckNegotiation;44 function Barbarina_WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean;45 procedure Barbarina_DoNegotiation;46 procedure MakeColonyShipPlan;47 48 private49 TurnOfMapAnalysis, Neighbours: integer;50 ContinentPresence: array[0..maxCOD-1] of integer;51 OceanPresence: array[0..maxCOD-1] of integer;52 ContinentSize: array[0..maxCOD-1] of integer;53 OceanSize: array[0..maxCOD-1] of integer;54 mixBest: array[0..nModelCategory-1] of integer;55 NegoCause: (CancelTreaty);56 function IsModelAvailable(rmix: integer): boolean;57 procedure FindBestModels;58 procedure AnalyzeMap;59 procedure RateAttack(uix: integer);60 function DoAttack(uix,AttackLoc: integer): boolean;61 function ProcessMove(uix: integer): boolean;62 procedure AttackAndPatrol;34 TBarbarina = class(TToolAI) 35 constructor Create(Nation: integer); override; 36 37 protected 38 ColonyShipPlan: TColonyShipPlan; 39 function Barbarina_GoHidden: boolean; // whether we should prepare for barbarina mode 40 function Barbarina_Go: boolean; // whether we should switch to barbarina mode now 41 procedure Barbarina_DoTurn; 42 procedure Barbarina_SetCityProduction; 43 function Barbarina_ChooseResearchAdvance: integer; 44 function Barbarina_WantCheckNegotiation(Nation: integer): boolean; 45 procedure Barbarina_DoCheckNegotiation; 46 function Barbarina_WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; 47 procedure Barbarina_DoNegotiation; 48 procedure MakeColonyShipPlan; 49 50 private 51 TurnOfMapAnalysis, Neighbours: integer; 52 ContinentPresence: array[0..maxCOD - 1] of integer; 53 OceanPresence: array[0..maxCOD - 1] of integer; 54 ContinentSize: array[0..maxCOD - 1] of integer; 55 OceanSize: array[0..maxCOD - 1] of integer; 56 mixBest: array[0..nModelCategory - 1] of integer; 57 NegoCause: (CancelTreaty); 58 function IsModelAvailable(rmix: integer): boolean; 59 procedure FindBestModels; 60 procedure AnalyzeMap; 61 procedure RateAttack(uix: integer); 62 function DoAttack(uix, AttackLoc: integer): boolean; 63 function ProcessMove(uix: integer): boolean; 64 procedure AttackAndPatrol; 63 65 end; 64 66 … … 67 69 68 70 uses 69 Pile;71 Pile; 70 72 71 73 type 72 TResearchModel=record73 Category,Domain,Weight,adStop,FutMStrength: integer;74 Upgrades: cardinal;75 Cap: array [0..nFeature-1] of integer;74 TResearchModel = record 75 Category, Domain, Weight, adStop, FutMStrength: integer; 76 Upgrades: cardinal; 77 Cap: array [0..nFeature - 1] of integer; 76 78 end; 77 79 78 80 const 79 //UnitKind 80 ukSlow=$01; ukFast=$02; 81 82 neumax=4096; 83 mixTownGuard=2; 84 85 PresenceUnknown=$10000; 86 87 WonderProductionThreshold=15; 88 WonderInclination=24.0; // higher value means lower probability of building wonder 89 ReduceDefense=16; // if this is x, 1/x of all units is used to defend cities 90 91 nResearchOrder=40; 92 ResearchOrder: array[0..nResearchOrder-1] of integer= 93 (adBronzeWorking,-adMapMaking,adChivalry,adMonotheism,adIronWorking, 94 adGunPowder,adTheology,adConstruction,adCodeOfLaws,-adEngineering,-adSeafaring, 95 -adNavigation,adMetallurgy,adBallistics,adScience,adExplosives, 96 adTactics,adSteel,-adSteamEngine,-adAmphibiousWarfare,-adMagnetism,adRadio, 97 adAutomobile,adMobileWarfare,adRailroad,adCommunism,adDemocracy, 98 adTheCorporation,adMassProduction,adIndustrialization,adRobotics,adComposites, 99 adTheLaser,adFlight,adAdvancedFlight,adSpaceFlight, 100 adSyntheticFood,adTransstellarColonization,adElectronics,adSmartWeapons); 101 102 nResearchModel=16; 103 ResearchModel: array[0..nResearchModel-1] of TResearchModel= 104 // Wea Arm Mob Sea Car Tur Bom Fue Air Nav Rad Sub Art Alp Sup Ove Air Spy SE NP Jet Ste Fan Fir Wil Aca Lin 105 ((Category:ctGroundSlow; Domain:dGround;Weight: 7;adStop:adIronWorking;Upgrades:$0003; 106 Cap:( 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 107 (Category:ctGroundFast; Domain:dGround;Weight: 7;adStop:adIronWorking;Upgrades:$0003; 108 Cap:( 3, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 109 (Category:ctGroundSlow; Domain:dGround;Weight: 7;adStop:adExplosives;Upgrades:$003F; 110 Cap:( 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 111 (Category:ctGroundFast; Domain:dGround;Weight: 7;adStop:adExplosives;Upgrades:$003F; 112 Cap:( 3, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 113 (Category:ctSeaTrans; Domain:dSea; Weight: 7;adStop:adExplosives;Upgrades:$000F; 114 Cap:( 0, 3, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 115 (Category:ctSeaArt; Domain:dSea; Weight: 7;adStop:adExplosives;Upgrades:$000F; 116 Cap:( 4, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 117 (Category:ctGroundSlow; Domain:dGround;Weight: 7;adStop:adAutomobile;Upgrades:$00FF; 118 Cap:( 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 119 (Category:ctGroundFast; Domain:dGround;Weight: 7;adStop:adAutomobile;Upgrades:$00FF; 120 Cap:( 3, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 121 (Category:ctSeaTrans; Domain:dSea; Weight: 9;adStop:-1;Upgrades:$00FF; 122 Cap:( 0, 4, 0, 2, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 123 (Category:ctSeaArt; Domain:dSea; Weight: 9;adStop:-1;Upgrades:$00FF; 124 Cap:( 5, 3, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 125 (Category:ctGroundSlow; Domain:dGround;Weight: 10;adStop:adCommunism;Upgrades:$05FF; 126 Cap:( 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 127 (Category:ctGroundFast; Domain:dGround;Weight: 10;adStop:adCommunism;Upgrades:$05FF; 128 Cap:( 5, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 129 (Category:ctGroundSlow; Domain:dGround;Weight: 10;adStop:adComposites;Upgrades:$07FF; 130 Cap:( 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1)), 131 (Category:ctGroundFast; Domain:dGround;Weight: 10;adStop:adComposites;Upgrades:$07FF; 132 Cap:( 5, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1)), 133 (Category:ctGroundSlow; Domain:dGround;Weight: 10;adStop:-1;Upgrades:$3FFF; 134 Cap:( 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1)), 135 (Category:ctGroundFast; Domain:dGround;Weight: 10;adStop:-1;Upgrades:$3FFF; 136 Cap:( 5, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1))); 137 EntryModel_Base=1; 138 EntryModel_GunPowder=3; 139 EntryModel_MassProduction=13; 81 //UnitKind 82 ukSlow = $01; 83 ukFast = $02; 84 85 neumax = 4096; 86 mixTownGuard = 2; 87 88 PresenceUnknown = $10000; 89 90 WonderProductionThreshold = 15; 91 WonderInclination = 24.0; // higher value means lower probability of building wonder 92 ReduceDefense = 16; // if this is x, 1/x of all units is used to defend cities 93 94 nResearchOrder = 40; 95 ResearchOrder: array[0..nResearchOrder - 1] of integer = 96 (adBronzeWorking, -adMapMaking, adChivalry, adMonotheism, adIronWorking, 97 adGunPowder, adTheology, adConstruction, adCodeOfLaws, -adEngineering, 98 -adSeafaring, -adNavigation, adMetallurgy, adBallistics, adScience, adExplosives, 99 adTactics, adSteel, -adSteamEngine, -adAmphibiousWarfare, -adMagnetism, adRadio, 100 adAutomobile, adMobileWarfare, adRailroad, adCommunism, adDemocracy, 101 adTheCorporation, adMassProduction, adIndustrialization, adRobotics, adComposites, 102 adTheLaser, adFlight, adAdvancedFlight, adSpaceFlight, 103 adSyntheticFood, adTransstellarColonization, adElectronics, adSmartWeapons); 104 105 nResearchModel = 16; 106 ResearchModel: array[0..nResearchModel - 1] of TResearchModel = 107 // Wea Arm Mob Sea Car Tur Bom Fue Air Nav Rad Sub Art Alp Sup Ove Air Spy SE NP Jet Ste Fan Fir Wil Aca Lin 108 ((Category: ctGroundSlow; Domain: dGround; Weight: 7; adStop: adIronWorking; 109 Upgrades: $0003; 110 Cap: (3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 111 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 112 (Category: ctGroundFast; Domain: dGround; Weight: 7; adStop: adIronWorking; 113 Upgrades: $0003; 114 Cap: (3, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 115 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 116 (Category: ctGroundSlow; Domain: dGround; Weight: 7; adStop: adExplosives; 117 Upgrades: $003F; 118 Cap: (3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 119 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 120 (Category: ctGroundFast; Domain: dGround; Weight: 7; adStop: adExplosives; 121 Upgrades: $003F; 122 Cap: (3, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 123 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 124 (Category: ctSeaTrans; Domain: dSea; Weight: 7; adStop: adExplosives; 125 Upgrades: $000F; 126 Cap: (0, 3, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 127 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 128 (Category: ctSeaArt; Domain: dSea; Weight: 7; adStop: adExplosives; Upgrades: $000F; 129 Cap: (4, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 130 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 131 (Category: ctGroundSlow; Domain: dGround; Weight: 7; adStop: adAutomobile; 132 Upgrades: $00FF; 133 Cap: (1, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 134 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 135 (Category: ctGroundFast; Domain: dGround; Weight: 7; adStop: adAutomobile; 136 Upgrades: $00FF; 137 Cap: (3, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 138 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 139 (Category: ctSeaTrans; Domain: dSea; Weight: 9; adStop: -1; Upgrades: $00FF; 140 Cap: (0, 4, 0, 2, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 141 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 142 (Category: ctSeaArt; Domain: dSea; Weight: 9; adStop: -1; Upgrades: $00FF; 143 Cap: (5, 3, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 144 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 145 (Category: ctGroundSlow; Domain: dGround; Weight: 10; adStop: adCommunism; 146 Upgrades: $05FF; 147 Cap: (3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 148 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 149 (Category: ctGroundFast; Domain: dGround; Weight: 10; adStop: adCommunism; 150 Upgrades: $05FF; 151 Cap: (5, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 152 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 153 (Category: ctGroundSlow; Domain: dGround; Weight: 10; adStop: adComposites; 154 Upgrades: $07FF; 155 Cap: (3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 156 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1)), 157 (Category: ctGroundFast; Domain: dGround; Weight: 10; adStop: adComposites; 158 Upgrades: $07FF; 159 Cap: (5, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 160 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1)), 161 (Category: ctGroundSlow; Domain: dGround; Weight: 10; adStop: -1; Upgrades: $3FFF; 162 Cap: (3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 163 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1)), 164 (Category: ctGroundFast; Domain: dGround; Weight: 10; adStop: -1; Upgrades: $3FFF; 165 Cap: (5, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 166 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1))); 167 EntryModel_Base = 1; 168 EntryModel_GunPowder = 3; 169 EntryModel_MassProduction = 13; 140 170 141 171 142 172 var 143 Moved: array[0..numax-1] of boolean;144 UnitPresence: array[0..lxmax*lymax-1] of byte;145 euixMap: array[0..lxmax*lymax-1] of smallint;146 uixAttack: array[0..neumax-1] of smallint;147 AttackScore: array[0..neumax-1] of integer;173 Moved: array[0..numax - 1] of boolean; 174 UnitPresence: array[0..lxmax * lymax - 1] of byte; 175 euixMap: array[0..lxmax * lymax - 1] of smallint; 176 uixAttack: array[0..neumax - 1] of smallint; 177 AttackScore: array[0..neumax - 1] of integer; 148 178 149 179 constructor TBarbarina.Create(Nation: integer); 150 180 begin 151 inherited;152 TurnOfMapAnalysis:=-1;181 inherited; 182 TurnOfMapAnalysis := -1; 153 183 end; 154 184 … … 156 186 function TBarbarina.IsModelAvailable(rmix: integer): boolean; 157 187 var 158 i,mix,MStrength: integer;188 i, mix, MStrength: integer; 159 189 begin 160 result:=false;161 with ResearchModel[rmix] do190 Result := False; 191 with ResearchModel[rmix] do 162 192 begin 163 MStrength:=CurrentMStrength(Domain); 164 for mix:=3 to RO.nModel-1 do 165 if ((MyModel[mix].kind=mkSelfDeveloped) or (MyModel[mix].kind=mkEnemyDeveloped)) 166 and (MyModel[mix].Domain=Domain) 167 and (Upgrades and not MyModel[mix].Upgrades=0) then 168 begin 169 result:= MStrength<(MyModel[mix].MStrength*3) div 2; // for future techs: don't count model available if 50% stronger possible 170 for i:=0 to nFeature-1 do if MyModel[mix].Cap[i]<Cap[i] then 171 begin result:=false; break end; 172 if result then break; 173 end; 174 end 193 MStrength := CurrentMStrength(Domain); 194 for mix := 3 to RO.nModel - 1 do 195 if ((MyModel[mix].kind = mkSelfDeveloped) or 196 (MyModel[mix].kind = mkEnemyDeveloped)) and (MyModel[mix].Domain = Domain) and 197 (Upgrades and not MyModel[mix].Upgrades = 0) then 198 begin 199 Result := MStrength < (MyModel[mix].MStrength * 3) div 2; 200 // for future techs: don't count model available if 50% stronger possible 201 for i := 0 to nFeature - 1 do 202 if MyModel[mix].Cap[i] < Cap[i] then 203 begin 204 Result := False; 205 break; 206 end; 207 if Result then 208 break; 209 end; 210 end; 175 211 end; 176 212 177 213 function TBarbarina.Barbarina_GoHidden: boolean; 178 214 var 179 V21,Loc1,cix: integer;180 Radius: TVicinity21Loc;215 V21, Loc1, cix: integer; 216 Radius: TVicinity21Loc; 181 217 begin 182 if IsResearched(adMassProduction) then218 if IsResearched(adMassProduction) then 183 219 begin 184 result:=true; 185 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 186 begin // search for modern resource 187 V21_to_Loc(Loc, Radius); 188 for V21:=1 to 26 do 189 begin 190 Loc1:=Radius[V21]; 191 if (Loc1>=0) and (RO.Map[Loc1] and fModern<>0) then 192 result:=false; 193 end 194 end 220 Result := True; 221 for cix := 0 to RO.nCity - 1 do 222 with MyCity[cix] do 223 if Loc >= 0 then 224 begin // search for modern resource 225 V21_to_Loc(Loc, Radius); 226 for V21 := 1 to 26 do 227 begin 228 Loc1 := Radius[V21]; 229 if (Loc1 >= 0) and (RO.Map[Loc1] and fModern <> 0) then 230 Result := False; 231 end; 232 end; 195 233 end 196 else if IsResearched(adGunPowder) then 197 result:=(RO.Tech[adTheRepublic]<tsSeen) and IsResearched(adTheology) 198 else result:=false; 234 else if IsResearched(adGunPowder) then 235 Result := (RO.Tech[adTheRepublic] < tsSeen) and IsResearched(adTheology) 236 else 237 Result := False; 199 238 end; 200 239 201 240 function TBarbarina.Barbarina_Go: boolean; 202 241 begin 203 if IsResearched(adMassProduction) then 204 result:= IsResearched(adTheology) 205 and IsModelAvailable(EntryModel_MassProduction) 206 else if IsResearched(adGunPowder) then 207 result:= IsResearched(adTheology) and IsResearched(adMapMaking) 208 and IsModelAvailable(EntryModel_GunPowder) 209 else 242 if IsResearched(adMassProduction) then 243 Result := IsResearched(adTheology) and IsModelAvailable(EntryModel_MassProduction) 244 else if IsResearched(adGunPowder) then 245 Result := IsResearched(adTheology) and IsResearched(adMapMaking) and 246 IsModelAvailable(EntryModel_GunPowder) 247 else 210 248 begin 211 result:=(RO.nCity>=3) and IsResearched(adMapMaking) 212 and IsModelAvailable(EntryModel_Base); 213 exit 214 end; 215 result:=result and ((RO.nUn>=RO.nCity*3) or (RO.Wonder[woZeus].EffectiveOwner=me)); 249 Result := (RO.nCity >= 3) and IsResearched(adMapMaking) and 250 IsModelAvailable(EntryModel_Base); 251 exit; 252 end; 253 Result := Result and ((RO.nUn >= RO.nCity * 3) or 254 (RO.Wonder[woZeus].EffectiveOwner = me)); 216 255 end; 217 256 218 257 procedure TBarbarina.AnalyzeMap; 219 258 var 220 Loc,Loc1,V8,f1,p1,cix: integer;221 Adjacent: TVicinity8Loc;259 Loc, Loc1, V8, f1, p1, cix: integer; 260 Adjacent: TVicinity8Loc; 222 261 begin 223 if TurnOfMapAnalysis=RO.Turn then exit; 224 225 // inherited AnalyzeMap; 226 227 // collect nation presence information for continents and oceans 228 fillchar(ContinentPresence, sizeof(ContinentPresence), 0); 229 fillchar(OceanPresence, sizeof(OceanPresence), 0); 230 fillchar(ContinentSize, sizeof(ContinentSize), 0); 231 fillchar(OceanSize, sizeof(OceanSize), 0); 232 for Loc:=0 to MapSize-1 do 262 if TurnOfMapAnalysis = RO.Turn then 263 exit; 264 265 // inherited; 266 267 // collect nation presence information for continents and oceans 268 fillchar(ContinentPresence, sizeof(ContinentPresence), 0); 269 fillchar(OceanPresence, sizeof(OceanPresence), 0); 270 fillchar(ContinentSize, sizeof(ContinentSize), 0); 271 fillchar(OceanSize, sizeof(OceanSize), 0); 272 for Loc := 0 to MapSize - 1 do 233 273 begin 234 f1:=Formation[Loc];235 case f1 of236 0..maxCOD-1:237 begin 238 p1:=RO.Territory[Loc];239 if p1>=0 then240 if Map[Loc] and fTerrain>=fGrass then241 begin 242 inc(ContinentSize[f1]);243 ContinentPresence[f1]:=ContinentPresence[f1] or (1 shl p1)274 f1 := Formation[Loc]; 275 case f1 of 276 0..maxCOD - 1: 277 begin 278 p1 := RO.Territory[Loc]; 279 if p1 >= 0 then 280 if Map[Loc] and fTerrain >= fGrass then 281 begin 282 Inc(ContinentSize[f1]); 283 ContinentPresence[f1] := ContinentPresence[f1] or (1 shl p1); 244 284 end 245 else246 begin 247 inc(OceanSize[f1]);248 OceanPresence[f1]:=OceanPresence[f1] or (1 shl p1);249 end 250 end; 251 nfUndiscovered:285 else 286 begin 287 Inc(OceanSize[f1]); 288 OceanPresence[f1] := OceanPresence[f1] or (1 shl p1); 289 end; 290 end; 291 nfUndiscovered: 252 292 begin // adjacent formations are not completely discovered 253 V8_to_Loc(Loc,Adjacent); 254 for V8:=0 to 7 do 255 begin 256 Loc1:=Adjacent[V8]; 257 if Loc1>=0 then 258 begin 259 f1:=Formation[Loc1]; 260 if (f1>=0) and (f1<maxCOD) then 261 if Map[Loc1] and fTerrain>=fGrass then 262 ContinentPresence[f1]:=ContinentPresence[f1] or PresenceUnknown 263 else OceanPresence[f1]:=OceanPresence[f1] or PresenceUnknown 264 end 265 end 266 end; 267 nfPeace: 293 V8_to_Loc(Loc, Adjacent); 294 for V8 := 0 to 7 do 295 begin 296 Loc1 := Adjacent[V8]; 297 if Loc1 >= 0 then 298 begin 299 f1 := Formation[Loc1]; 300 if (f1 >= 0) and (f1 < maxCOD) then 301 if Map[Loc1] and fTerrain >= fGrass then 302 ContinentPresence[f1] := ContinentPresence[f1] or PresenceUnknown 303 else 304 OceanPresence[f1] := OceanPresence[f1] or PresenceUnknown; 305 end; 306 end; 307 end; 308 nfPeace: 268 309 begin // nation present in adjacent formations 269 V8_to_Loc(Loc,Adjacent);270 for V8:=0 to 7 do271 begin 272 Loc1:=Adjacent[V8];273 if Loc1>=0 then274 begin 275 f1:=Formation[Loc1];276 if (f1>=0) and (f1<maxCOD) then277 if Map[Loc1] and fTerrain>=fGrass then278 ContinentPresence[f1]:=ContinentPresence[f1]279 or (1 shl RO.Territory[Loc])280 else OceanPresence[f1]:=OceanPresence[f1]281 or (1 shl RO.Territory[Loc])282 end 283 end 310 V8_to_Loc(Loc, Adjacent); 311 for V8 := 0 to 7 do 312 begin 313 Loc1 := Adjacent[V8]; 314 if Loc1 >= 0 then 315 begin 316 f1 := Formation[Loc1]; 317 if (f1 >= 0) and (f1 < maxCOD) then 318 if Map[Loc1] and fTerrain >= fGrass then 319 ContinentPresence[f1] := 320 ContinentPresence[f1] or (1 shl RO.Territory[Loc]) 321 else 322 OceanPresence[f1] := OceanPresence[f1] or (1 shl RO.Territory[Loc]); 323 end; 324 end; 284 325 end; 285 326 end; 286 327 end; 287 328 288 Neighbours:=0; 289 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 290 if (Loc>=0) and (Formation[Loc]>=0) and (Formation[Loc]<maxCOD) then 291 Neighbours:=Neighbours or ContinentPresence[Formation[Loc]]; 292 Neighbours:= Neighbours and not PresenceUnknown; 293 294 TurnOfMapAnalysis:=RO.Turn; 329 Neighbours := 0; 330 for cix := 0 to RO.nCity - 1 do 331 with MyCity[cix] do 332 if (Loc >= 0) and (Formation[Loc] >= 0) and (Formation[Loc] < maxCOD) then 333 Neighbours := Neighbours or ContinentPresence[Formation[Loc]]; 334 Neighbours := Neighbours and not PresenceUnknown; 335 336 TurnOfMapAnalysis := RO.Turn; 295 337 end; 296 338 297 339 procedure TBarbarina.FindBestModels; 298 340 var 299 i,mix,rmix,cat: integer;341 i, mix, rmix, cat: integer; 300 342 begin 301 for i:=0 to nModelCategory-1 do mixBest[i]:=-1; 302 for rmix:=nResearchModel-1 downto 0 do with ResearchModel[rmix] do 303 if mixBest[Category]<0 then 304 for mix:=3 to RO.nModel-1 do 305 if (MyModel[mix].Domain=Domain) 306 and (Upgrades and not MyModel[mix].Upgrades=0) then 307 begin 308 mixBest[Category]:=mix; 309 for i:=0 to nFeature-1 do if MyModel[mix].Cap[i]<Cap[i] then 310 begin mixBest[Category]:=-1; break end; 311 if mixBest[Category]>=0 then break; 312 end; 313 for mix:=3 to RO.nModel-1 do with MyModel[mix] do if Kind<=mkEnemyDeveloped then 314 begin 315 cat:=-1; 316 case Domain of 317 dGround: 318 if Speed>=250 then cat:=ctGroundFast 319 else cat:=ctGroundSlow; 320 dSea: 321 if Cap[mcSeaTrans]>0 then cat:=ctSeaTrans 322 else if Cap[mcArtillery]>0 then cat:=ctSeaArt; 323 end; 324 if (cat>=0) and (mix<>mixBest[cat]) 325 and ((mixBest[cat]<0) or (Weight*MStrength 326 >MyModel[mixBest[cat]].Weight+MyModel[mixBest[cat]].MStrength)) then 327 mixBest[cat]:=mix; 328 end; 329 if (mixBest[ctSeaTrans]<0) and not IsResearched(adExplosives) then // longboat? 330 for mix:=3 to RO.nModel-1 do if MyModel[mix].Cap[mcSeaTrans]>0 then 331 begin mixBest[ctSeaTrans]:=mix; break end; 343 for i := 0 to nModelCategory - 1 do 344 mixBest[i] := -1; 345 for rmix := nResearchModel - 1 downto 0 do 346 with ResearchModel[rmix] do 347 if mixBest[Category] < 0 then 348 for mix := 3 to RO.nModel - 1 do 349 if (MyModel[mix].Domain = Domain) and 350 (Upgrades and not MyModel[mix].Upgrades = 0) then 351 begin 352 mixBest[Category] := mix; 353 for i := 0 to nFeature - 1 do 354 if MyModel[mix].Cap[i] < Cap[i] then 355 begin 356 mixBest[Category] := -1; 357 break; 358 end; 359 if mixBest[Category] >= 0 then 360 break; 361 end; 362 for mix := 3 to RO.nModel - 1 do 363 with MyModel[mix] do 364 if Kind <= mkEnemyDeveloped then 365 begin 366 cat := -1; 367 case Domain of 368 dGround: 369 if Speed >= 250 then 370 cat := ctGroundFast 371 else 372 cat := ctGroundSlow; 373 dSea: 374 if Cap[mcSeaTrans] > 0 then 375 cat := ctSeaTrans 376 else if Cap[mcArtillery] > 0 then 377 cat := ctSeaArt; 378 end; 379 if (cat >= 0) and (mix <> mixBest[cat]) and 380 ((mixBest[cat] < 0) or (Weight * MStrength > MyModel[mixBest[cat]].Weight + 381 MyModel[mixBest[cat]].MStrength)) then 382 mixBest[cat] := mix; 383 end; 384 if (mixBest[ctSeaTrans] < 0) and not IsResearched(adExplosives) then // longboat? 385 for mix := 3 to RO.nModel - 1 do 386 if MyModel[mix].Cap[mcSeaTrans] > 0 then 387 begin 388 mixBest[ctSeaTrans] := mix; 389 break; 390 end; 332 391 end; 333 392 334 393 procedure TBarbarina.Barbarina_DoTurn; 335 394 begin 336 if (RO.Government in [gRepublic,gDemocracy,gFuture]) 337 or (RO.Government<>gFundamentalism) and (RO.Government<>gAnarchy)338 andIsResearched(adTheology) then339 Revolution;340 341 AnalyzeMap;342 343 FindBestModels;344 345 AttackAndPatrol;395 if (RO.Government in [gRepublic, gDemocracy, gFuture]) or 396 (RO.Government <> gFundamentalism) and (RO.Government <> gAnarchy) and 397 IsResearched(adTheology) then 398 Revolution; 399 400 AnalyzeMap; 401 402 FindBestModels; 403 404 AttackAndPatrol; 346 405 end; 347 406 … … 349 408 procedure TBarbarina.RateAttack(uix: integer); 350 409 var 351 MoveStyle,TestLoc,TestTime,NextLoc,NextTime,V8,RemHealth,RecoverTurns,352 Score,BestScore,euixBest,uixOld: integer;353 NextTile: cardinal;354 Adjacent: TVicinity8Loc;355 Defense: ^TUnitInfo;356 Reached: array[0..lxmax*lymax-1] of boolean;410 MoveStyle, TestLoc, TestTime, NextLoc, NextTime, V8, RemHealth, 411 RecoverTurns, Score, BestScore, euixBest, uixOld: integer; 412 NextTile: cardinal; 413 Adjacent: TVicinity8Loc; 414 Defense: ^TUnitInfo; 415 Reached: array[0..lxmax * lymax - 1] of boolean; 357 416 begin 358 with MyUnit[uix] do if Movement>0 then 417 with MyUnit[uix] do 418 if Movement > 0 then 419 begin 420 BestScore := 0; 421 fillchar(Reached, MapSize, False); 422 MoveStyle := GetMyMoveStyle(mix, Health); 423 Pile.Create(MapSize); 424 Pile.Put(Loc, $800 - Movement); 425 while Pile.Get(TestLoc, TestTime) do 426 begin 427 Reached[TestLoc] := True; 428 V8_to_Loc(TestLoc, Adjacent); 429 for V8 := 0 to 7 do 430 begin 431 NextLoc := Adjacent[V8]; 432 if (NextLoc >= 0) and not Reached[NextLoc] then 433 begin 434 NextTile := Map[NextLoc]; 435 if euixMap[NextLoc] >= 0 then 436 begin // check attack 437 Defense := @RO.EnemyUn[euixMap[NextLoc]]; 438 if Unit_AttackForecast(uix, NextLoc, $800 - TestTime, RemHealth) then 439 begin 440 if RemHealth <= 0 then // send unit into death? 441 begin 442 Score := 0; 443 if ($800 - TestTime >= 100) and 444 ((MyModel[mix].Domain = dGround) and 445 (NextTile and fTerrain >= fGrass) or 446 (MyModel[mix].Domain = dSea) and (NextTile and 447 fTerrain < fGrass)) and 448 (MyModel[mix].Attack > MyModel[mix].Defense) then 449 begin 450 Score := (Defense.Health + RemHealth) * 451 RO.EnemyModel[Defense.emix].Cost * 2 div MyModel[mix].Cost; 452 if NextTile and fCity <> 0 then 453 Score := Score * 4; 454 end; 455 end 456 else 457 Score := RO.EnemyModel[Defense.emix].Cost * 25 - 458 (Health - RemHealth) * MyModel[mix].Cost shr 4; 459 if (Score > BestScore) and (Score > AttackScore[euixMap[NextLoc]]) then 460 begin 461 BestScore := Score; 462 euixBest := euixMap[NextLoc]; 463 end; 464 end; 465 end 466 else if (NextTile and (fUnit or fCity) = 0) or 467 (NextTile and fOwned <> 0) then 468 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 469 RecoverTurns, Map[TestLoc], NextTile, True) of 470 csOk: 471 if NextTime < $800 then 472 Pile.Put(NextLoc, NextTime); 473 csForbiddenTile: 474 Reached[NextLoc] := True; // don't check moving there again 475 csCheckTerritory: 476 if (NextTime < $800) and (RO.Territory[NextLoc] = 477 RO.Territory[TestLoc]) then 478 Pile.Put(NextLoc, NextTime); 479 end; 480 end; 481 end; 482 end; 483 Pile.Free; 484 485 if BestScore > 0 then 486 begin 487 uixOld := uixAttack[euixBest]; 488 AttackScore[euixBest] := BestScore; 489 uixAttack[euixBest] := uix; 490 if uixOld >= 0 then 491 RateAttack(uixOld); 492 end; 493 end; 494 end; 495 496 function TBarbarina.DoAttack(uix, AttackLoc: integer): boolean; 497 // AttackLoc=maNextCity means bombard only 498 var 499 MoveResult, Kind, Temp, MoveStyle, TestLoc, TestTime, NextLoc, 500 NextTime, V8, RecoverTurns, ecix: integer; 501 NextTile: cardinal; 502 AttackPositionReached, IsBombardment: boolean; 503 Adjacent: TVicinity8Loc; 504 PreLoc: array[0..lxmax * lymax - 1] of word; 505 Reached: array[0..lxmax * lymax - 1] of boolean; 506 begin 507 Result := False; 508 IsBombardment := AttackLoc = maNextCity; 509 with MyUnit[uix] do 359 510 begin 360 BestScore:=0; 361 fillchar(Reached, MapSize, false); 362 MoveStyle:=GetMyMoveStyle(mix, Health); 363 Pile.Create(MapSize); 364 Pile.Put(Loc, $800-Movement); 365 while Pile.Get(TestLoc, TestTime) do 511 if (MyModel[mix].Domain = dGround) and (MyModel[mix].Attack > 0) then 512 if MyModel[mix].Speed >= 250 then 513 Kind := ukFast 514 else 515 Kind := ukSlow 516 else 517 Kind := 0; 518 fillchar(Reached, MapSize, False); 519 AttackPositionReached := False; 520 MoveStyle := GetMyMoveStyle(mix, Health); 521 Pile.Create(MapSize); 522 Pile.Put(Loc, $800 - Movement); 523 while Pile.Get(TestLoc, TestTime) do 366 524 begin 367 Reached[TestLoc]:=true; 368 V8_to_Loc(TestLoc, Adjacent); 369 for V8:=0 to 7 do 370 begin 371 NextLoc:=Adjacent[V8]; 372 if (NextLoc>=0) and not Reached[NextLoc] then 373 begin 374 NextTile:=Map[NextLoc]; 375 if euixMap[NextLoc]>=0 then 376 begin // check attack 377 Defense:=@RO.EnemyUn[euixMap[NextLoc]]; 378 if Unit_AttackForecast(uix, NextLoc, $800-TestTime, RemHealth) then 525 if (TestTime >= $800) or (AttackLoc = maNextCity) and (TestTime > $800 - 100) then 526 break; 527 Reached[TestLoc] := True; 528 V8_to_Loc(TestLoc, Adjacent); 529 for V8 := 0 to 7 do 530 begin 531 NextLoc := Adjacent[V8]; 532 if NextLoc >= 0 then 533 begin 534 if IsBombardment and (Map[NextLoc] and (fCity or 535 fUnit or fOwned or fObserved) = fCity or fObserved) and 536 (RO.Treaty[RO.Territory[NextLoc]] < trPeace) then 537 begin 538 City_FindEnemyCity(NextLoc, ecix); 539 assert(ecix >= 0); 540 with RO.EnemyCity[ecix] do 541 if (Size > 2) and (Flags and ciCoastalFort = 0) then 542 AttackLoc := NextLoc; 543 end; 544 if (NextLoc = AttackLoc) and ((MyModel[mix].Domain <> dSea) or 545 (Map[TestLoc] and fTerrain < fGrass)) then 546 // ships can only attack from water 547 begin 548 AttackPositionReached := True; 549 break; 550 end 551 else if not Reached[NextLoc] then 552 begin 553 NextTile := Map[NextLoc]; 554 if (NextTile and (fUnit or fCity) = 0) or 555 (NextTile and fOwned <> 0) then 556 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 557 RecoverTurns, Map[TestLoc], NextTile, True) of 558 csOk: 559 if Pile.Put(NextLoc, NextTime) then 560 PreLoc[NextLoc] := TestLoc; 561 csForbiddenTile: 562 Reached[NextLoc] := True; // don't check moving there again 563 csCheckTerritory: 564 if RO.Territory[NextLoc] = RO.Territory[TestLoc] then 565 if Pile.Put(NextLoc, NextTime) then 566 PreLoc[NextLoc] := TestLoc; 567 end; 568 end; 569 end; 570 end; 571 if AttackPositionReached then 572 begin 573 PreLoc[NextLoc] := TestLoc; 574 break; 575 end; 576 end; 577 Pile.Free; 578 if not AttackPositionReached then 579 exit; 580 581 TestLoc := AttackLoc; 582 NextLoc := PreLoc[TestLoc]; 583 while TestLoc <> Loc do 584 begin 585 Temp := TestLoc; 586 TestLoc := NextLoc; 587 NextLoc := PreLoc[TestLoc]; 588 PreLoc[TestLoc] := Temp; 589 end; 590 591 UnitPresence[Loc] := UnitPresence[Loc] and not Kind; 592 // assume unit was only one of kind here 593 repeat 594 NextLoc := PreLoc[Loc]; 595 MoveResult := Unit_Step(uix, NextLoc); 596 until (NextLoc = AttackLoc) or (MoveResult and rExecuted = 0) or 597 (MoveResult and rUnitRemoved <> 0); 598 Result := (NextLoc = AttackLoc) and (MoveResult and rExecuted <> 0); 599 600 if IsBombardment and Result then 601 begin 602 City_FindEnemyCity(AttackLoc, ecix); 603 assert(ecix >= 0); 604 while (Movement >= 100) and (RO.EnemyCity[ecix].Size > 2) do 605 Unit_Step(uix, AttackLoc); 606 end; 607 608 if Loc >= 0 then 609 UnitPresence[Loc] := UnitPresence[Loc] or Kind; 610 end; 611 end; 612 613 function TBarbarina.ProcessMove(uix: integer): boolean; 614 // return true if no new enemy spotted 615 const 616 DistanceScore = 4; 617 var 618 PatrolScore, BestCount, PatrolLoc, TestLoc, NextLoc, TestTime, V8, 619 TestScore, MoveResult, MoveStyle, NextTime, TerrOwner, Kind, Temp, 620 RecoverTurns, MaxScore: integer; 621 Tile, NextTile: cardinal; 622 CaptureOnly, PeaceBorder, done, NextToEnemyCity: boolean; 623 Adjacent: TVicinity8Loc; 624 AdjacentUnknown: array[0..lxmax * lymax - 1] of shortint; 625 PreLoc: array[0..lxmax * lymax - 1] of word; 626 MoreTurn: array[0..lxmax * lymax - 1] of byte; 627 628 begin 629 Result := True; 630 done := False; 631 while not done do 632 with MyUnit[uix] do 633 begin 634 if (MyModel[mix].Domain = dSea) and (Health < 100) and 635 ((Health < 34) or (MyModel[mix].Cap[mcSeaTrans] > 0)) then 636 begin 637 if Map[Loc] and fCity = 0 then 638 Unit_MoveEx(uix, maNextCity); 639 exit; 640 end; 641 642 if (MyModel[mix].Domain = dGround) and (MyModel[mix].Attack > 0) then 643 if MyModel[mix].Speed >= 250 then 644 Kind := ukFast 645 else 646 Kind := ukSlow 647 else 648 Kind := 0; 649 CaptureOnly := (Health < 100) and ((Map[Loc] and fCity <> 0) or 650 ((100 - Health) * Terrain[Map[Loc] and fTerrain].Defense > 60) and 651 not (Map[Loc] and fTerrain in [fOcean, fShore, fArctic, fDesert])); 652 MoveStyle := GetMyMoveStyle(mix, Health); 653 654 if MyModel[mix].Attack > 0 then 655 MaxScore := $400 656 else 657 MaxScore := $400 - 32 + 5; 658 PatrolScore := -999999; 659 PatrolLoc := -1; 660 FillChar(AdjacentUnknown, MapSize, $FF); // -1, indicates tiles not checked yet 661 Pile.Create(MapSize); 662 Pile.Put(Loc, $800 - Movement); 663 while Pile.Get(TestLoc, TestTime) do 664 begin 665 if (MaxScore * $1000 - DistanceScore * TestTime <= PatrolScore) 666 // assume a score of $400 is the best achievable 667 or CaptureOnly and (TestTime >= $1000) then 668 break; 669 670 TestScore := 0; 671 Tile := Map[TestLoc]; 672 assert(Tile and (fUnit or fOwned) <> fUnit); 673 TerrOwner := RO.Territory[TestLoc]; 674 AdjacentUnknown[TestLoc] := 0; 675 PeaceBorder := False; 676 NextToEnemyCity := False; 677 678 if ((Tile and fCity) <> 0) and ((Tile and fOwned) = 0) then 679 begin 680 if (MyModel[mix].Domain = dGround) and (MyModel[mix].Attack > 0) and 681 ((TerrOwner < 0) 682 // happens only for unobserved cities of extinct tribes, new owner unknown 683 or (RO.Treaty[TerrOwner] < trPeace)) then 684 if (Tile and fObserved <> 0) and (Tile and fUnit = 0) then 685 TestScore := $400 // unfriendly undefended city -- capture! 686 else 687 TestScore := $400 - 14; // unfriendly city, not observed or defended 688 end 689 690 else 691 begin // no enemy city or unit here 692 V8_to_Loc(TestLoc, Adjacent); 693 for V8 := 0 to 7 do 694 begin 695 NextLoc := Adjacent[V8]; 696 if (NextLoc >= 0) and (AdjacentUnknown[NextLoc] < 0) then 379 697 begin 380 if RemHealth<=0 then // send unit into death? 381 begin 382 Score:=0; 383 if ($800-TestTime>=100) 384 and ((MyModel[mix].Domain=dGround) and (NextTile and fTerrain>=fGrass) 385 or (MyModel[mix].Domain=dSea) and (NextTile and fTerrain<fGrass)) 386 and (MyModel[mix].Attack>MyModel[mix].Defense) then 387 begin 388 Score:=(Defense.Health+RemHealth) 389 *RO.EnemyModel[Defense.emix].Cost*2 div MyModel[mix].Cost; 390 if NextTile and fCity<>0 then 391 Score:=Score*4; 392 end 393 end 394 else Score:=RO.EnemyModel[Defense.emix].Cost*25-(Health-RemHealth)*MyModel[mix].Cost shr 4; 395 if (Score>BestScore) and (Score>AttackScore[euixMap[NextLoc]]) then 396 begin 397 BestScore:=Score; 398 euixBest:=euixMap[NextLoc] 399 end 400 end 401 end 402 else if (NextTile and (fUnit or fCity)=0) 403 or (NextTile and fOwned<>0) then 404 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 405 RecoverTurns, Map[TestLoc], NextTile, true) of 406 csOk: 407 if NextTime<$800 then 408 Pile.Put(NextLoc, NextTime); 409 csForbiddenTile: 410 Reached[NextLoc]:=true; // don't check moving there again 411 csCheckTerritory: 412 if (NextTime<$800) and (RO.Territory[NextLoc]=RO.Territory[TestLoc]) then 413 Pile.Put(NextLoc, NextTime); 414 end 415 end 416 end; 417 end; 418 Pile.Free; 419 420 if BestScore>0 then 421 begin 422 uixOld:=uixAttack[euixBest]; 423 AttackScore[euixBest]:=BestScore; 424 uixAttack[euixBest]:=uix; 425 if uixOld>=0 then 426 RateAttack(uixOld); 427 end 428 end 429 end; 430 431 function TBarbarina.DoAttack(uix,AttackLoc: integer): boolean; 432 // AttackLoc=maNextCity means bombard only 433 var 434 MoveResult,Kind,Temp,MoveStyle,TestLoc,TestTime,NextLoc,NextTime,V8, 435 RecoverTurns,ecix: integer; 436 NextTile: cardinal; 437 AttackPositionReached, IsBombardment: boolean; 438 Adjacent: TVicinity8Loc; 439 PreLoc: array[0..lxmax*lymax-1] of word; 440 Reached: array[0..lxmax*lymax-1] of boolean; 441 begin 442 result:=false; 443 IsBombardment:= AttackLoc=maNextCity; 444 with MyUnit[uix] do 445 begin 446 if (MyModel[mix].Domain=dGround) and (MyModel[mix].Attack>0) then 447 if MyModel[mix].Speed>=250 then Kind:=ukFast 448 else Kind:=ukSlow 449 else Kind:=0; 450 fillchar(Reached, MapSize, false); 451 AttackPositionReached:=false; 452 MoveStyle:=GetMyMoveStyle(mix, Health); 453 Pile.Create(MapSize); 454 Pile.Put(Loc, $800-Movement); 455 while Pile.Get(TestLoc, TestTime) do 456 begin 457 if (TestTime>=$800) or (AttackLoc=maNextCity) and (TestTime>$800-100) then 458 break; 459 Reached[TestLoc]:=true; 460 V8_to_Loc(TestLoc, Adjacent); 461 for V8:=0 to 7 do 462 begin 463 NextLoc:=Adjacent[V8]; 464 if NextLoc>=0 then 465 begin 466 if IsBombardment and (Map[NextLoc] and 467 (fCity or fUnit or fOwned or fObserved)=fCity or fObserved) 468 and (RO.Treaty[RO.Territory[NextLoc]]<trPeace) then 469 begin 470 City_FindEnemyCity(NextLoc, ecix); 471 assert(ecix>=0); 472 with RO.EnemyCity[ecix] do 473 if (Size>2) and (Flags and ciCoastalFort=0) then 474 AttackLoc:=NextLoc 475 end; 476 if (NextLoc=AttackLoc) 477 and ((MyModel[mix].Domain<>dSea) or (Map[TestLoc] and fTerrain<fGrass)) then 478 // ships can only attack from water 479 begin AttackPositionReached:=true; break end 480 else if not Reached[NextLoc] then 481 begin 482 NextTile:=Map[NextLoc]; 483 if (NextTile and (fUnit or fCity)=0) 484 or (NextTile and fOwned<>0) then 485 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 486 RecoverTurns, Map[TestLoc], NextTile, true) of 487 csOk: 488 if Pile.Put(NextLoc, NextTime) then 489 PreLoc[NextLoc]:=TestLoc; 490 csForbiddenTile: 491 Reached[NextLoc]:=true; // don't check moving there again 492 csCheckTerritory: 493 if RO.Territory[NextLoc]=RO.Territory[TestLoc] then 494 if Pile.Put(NextLoc, NextTime) then 495 PreLoc[NextLoc]:=TestLoc; 496 end 497 end 498 end 499 end; 500 if AttackPositionReached then 501 begin 502 PreLoc[NextLoc]:=TestLoc; 503 break 504 end 505 end; 506 Pile.Free; 507 if not AttackPositionReached then exit; 508 509 TestLoc:=AttackLoc; 510 NextLoc:=PreLoc[TestLoc]; 511 while TestLoc<>Loc do 512 begin 513 Temp:=TestLoc; 514 TestLoc:=NextLoc; 515 NextLoc:=PreLoc[TestLoc]; 516 PreLoc[TestLoc]:=Temp; 517 end; 518 519 UnitPresence[Loc]:=UnitPresence[Loc] and not Kind; // assume unit was only one of kind here 520 repeat 521 NextLoc:=PreLoc[Loc]; 522 MoveResult:=Unit_Step(uix, NextLoc); 523 until (NextLoc=AttackLoc) or (MoveResult and rExecuted=0) 524 or (MoveResult and rUnitRemoved<>0); 525 result:= (NextLoc=AttackLoc) and (MoveResult and rExecuted<>0); 526 527 if IsBombardment and result then 528 begin 529 City_FindEnemyCity(AttackLoc, ecix); 530 assert(ecix>=0); 531 while (Movement>=100) and (RO.EnemyCity[ecix].Size>2) do 532 Unit_Step(uix, AttackLoc); 533 end; 534 535 if Loc>=0 then 536 UnitPresence[Loc]:=UnitPresence[Loc] or Kind; 537 end 538 end; 539 540 function TBarbarina.ProcessMove(uix: integer): boolean; 541 // return true if no new enemy spotted 542 const 543 DistanceScore=4; 544 var 545 PatrolScore,BestCount,PatrolLoc,TestLoc,NextLoc,TestTime,V8, 546 TestScore,MoveResult,MoveStyle,NextTime,TerrOwner,Kind,Temp,RecoverTurns, 547 MaxScore: integer; 548 Tile,NextTile: cardinal; 549 CaptureOnly,PeaceBorder, done, NextToEnemyCity: boolean; 550 Adjacent: TVicinity8Loc; 551 AdjacentUnknown: array[0..lxmax*lymax-1] of shortint; 552 PreLoc: array[0..lxmax*lymax-1] of word; 553 MoreTurn: array[0..lxmax*lymax-1] of byte; 554 555 begin 556 result:=true; 557 done:=false; 558 while not done do with MyUnit[uix] do 559 begin 560 if (MyModel[mix].Domain=dSea) and (Health<100) 561 and ((Health<34) or (MyModel[mix].Cap[mcSeaTrans]>0)) then 562 begin 563 if Map[Loc] and fCity=0 then 564 Unit_MoveEx(uix,maNextCity); 565 exit; 566 end; 567 568 if (MyModel[mix].Domain=dGround) and (MyModel[mix].Attack>0) then 569 if MyModel[mix].Speed>=250 then Kind:=ukFast 570 else Kind:=ukSlow 571 else Kind:=0; 572 CaptureOnly:=(Health<100) 573 and ((Map[Loc] and fCity<>0) 574 or ((100-Health)*Terrain[Map[Loc] and fTerrain].Defense>60) 575 and not (Map[Loc] and fTerrain in [fOcean, fShore, fArctic, fDesert])); 576 MoveStyle:=GetMyMoveStyle(mix, Health); 577 578 if MyModel[mix].Attack>0 then MaxScore:=$400 579 else MaxScore:=$400-32+5; 580 PatrolScore:=-999999; 581 PatrolLoc:=-1; 582 FillChar(AdjacentUnknown,MapSize,$FF); // -1, indicates tiles not checked yet 583 Pile.Create(MapSize); 584 Pile.Put(Loc, $800-Movement); 585 while Pile.Get(TestLoc,TestTime) do 586 begin 587 if (MaxScore*$1000-DistanceScore*TestTime<=PatrolScore) // assume a score of $400 is the best achievable 588 or CaptureOnly and (TestTime>=$1000) then 589 break; 590 591 TestScore:=0; 592 Tile:=Map[TestLoc]; 593 assert(Tile and (fUnit or fOwned)<>fUnit); 594 TerrOwner:=RO.Territory[TestLoc]; 595 AdjacentUnknown[TestLoc]:=0; 596 PeaceBorder:=false; 597 NextToEnemyCity:=false; 598 599 if ((Tile and fCity)<>0) and ((Tile and fOwned)=0) then 600 begin 601 if (MyModel[mix].Domain=dGround) and (MyModel[mix].Attack>0) 602 and ((TerrOwner<0) // happens only for unobserved cities of extinct tribes, new owner unknown 603 or (RO.Treaty[TerrOwner]<trPeace)) then 604 if (Tile and fObserved<>0) and (Tile and fUnit=0) then 605 TestScore:=$400 // unfriendly undefended city -- capture! 606 else TestScore:=$400-14 // unfriendly city, not observed or defended 607 end 608 609 else 610 begin // no enemy city or unit here 611 V8_to_Loc(TestLoc,Adjacent); 612 for V8:=0 to 7 do 613 begin 614 NextLoc:=Adjacent[V8]; 615 if (NextLoc>=0) and (AdjacentUnknown[NextLoc]<0) then 616 begin 617 NextTile:=Map[NextLoc]; 618 if NextTile and fTerrain=fUNKNOWN then 619 inc(AdjacentUnknown[TestLoc]) 620 else if NextTile and fTerrain=fArctic then 621 else if NextTile and (fCity or fUnit or fOwned or fObserved)= 622 fCity or fUnit or fObserved then 623 NextToEnemyCity:=true 624 else case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, RecoverTurns, Tile, NextTile, true) of 625 csOk: 698 NextTile := Map[NextLoc]; 699 if NextTile and fTerrain = fUNKNOWN then 700 Inc(AdjacentUnknown[TestLoc]) 701 else if NextTile and fTerrain = fArctic then 702 else if NextTile and (fCity or fUnit or fOwned or fObserved) = 703 fCity or fUnit or fObserved then 704 NextToEnemyCity := True 705 else 706 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 707 RecoverTurns, Tile, NextTile, True) of 708 csOk: 626 709 { if (NextTime and $7FFFF000=TestTime and $7FFFF000) 627 710 or (UnitPresence[TestLoc] and Kind=0) 628 711 or (Tile and fCity<>0) 629 712 or (Tile and fTerImp=tiFort) or (Tile and fTerImp=tiBase) then} 630 begin631 if Pile.Put(NextLoc, NextTime+RecoverTurns*$1000) then632 713 begin 633 PreLoc[NextLoc]:=TestLoc; 634 MoreTurn[NextLoc]:=NextTime shr 12 and $FFF; 635 end 714 if Pile.Put(NextLoc, NextTime + RecoverTurns * $1000) then 715 begin 716 PreLoc[NextLoc] := TestLoc; 717 MoreTurn[NextLoc] := NextTime shr 12 and $FFF; 718 end; 719 end; 720 csForbiddenTile: 721 begin 722 AdjacentUnknown[NextLoc] := 0; // don't check moving there again 723 if NextTile and fPeace <> 0 then 724 PeaceBorder := True; 725 end; 726 csCheckTerritory: 727 if RO.Territory[NextLoc] = TerrOwner then 728 begin 729 if Pile.Put(NextLoc, NextTime + RecoverTurns * $1000) then 730 begin 731 PreLoc[NextLoc] := TestLoc; 732 MoreTurn[NextLoc] := NextTime shr 12 and $FFF; 733 end; 734 end 735 else 736 PeaceBorder := True; 636 737 end; 637 csForbiddenTile: 638 begin 639 AdjacentUnknown[NextLoc]:=0; // don't check moving there again 640 if NextTile and fPeace<>0 then PeaceBorder:=true; 641 end; 642 csCheckTerritory: 643 if RO.Territory[NextLoc]=TerrOwner then 644 begin 645 if Pile.Put(NextLoc, NextTime+RecoverTurns*$1000) then 646 begin 647 PreLoc[NextLoc]:=TestLoc; 648 MoreTurn[NextLoc]:=NextTime shr 12 and $FFF; 649 end 650 end 651 else PeaceBorder:=true; 652 end 653 end 654 end; 655 if not CaptureOnly then 656 if NextToEnemyCity and (MyModel[mix].Attack>0) 657 and (MyModel[mix].Domain=dGround) then 658 TestScore:=$400-14 659 else if AdjacentUnknown[TestLoc]>0 then 660 if PeaceBorder or (TerrOwner>=0) and (TerrOwner<>me) 661 and (RO.Treaty[TerrOwner]<trPeace) then 662 TestScore:=$400-32+AdjacentUnknown[TestLoc] 663 else TestScore:=$400-64+AdjacentUnknown[TestLoc] 664 else if PeaceBorder then TestScore:=$400-32 665 else TestScore:=(RO.Turn-RO.MapObservedLast[TestLoc]) div 16; 666 end; // no enemy city or unit here 667 668 if TestScore>0 then 669 begin 670 TestScore:=TestScore*$1000-DistanceScore*TestTime; 671 if TestScore>PatrolScore then 672 BestCount:=0; 673 if TestScore>=PatrolScore then 674 begin 675 inc(BestCount); 676 if random(BestCount)=0 then 677 begin 678 PatrolScore:=TestScore; 679 PatrolLoc:=TestLoc; 680 end 738 end; 739 end; 740 if not CaptureOnly then 741 if NextToEnemyCity and (MyModel[mix].Attack > 0) and 742 (MyModel[mix].Domain = dGround) then 743 TestScore := $400 - 14 744 else if AdjacentUnknown[TestLoc] > 0 then 745 if PeaceBorder or (TerrOwner >= 0) and (TerrOwner <> me) and 746 (RO.Treaty[TerrOwner] < trPeace) then 747 TestScore := $400 - 32 + AdjacentUnknown[TestLoc] 748 else 749 TestScore := $400 - 64 + AdjacentUnknown[TestLoc] 750 else if PeaceBorder then 751 TestScore := $400 - 32 752 else 753 TestScore := (RO.Turn - RO.MapObservedLast[TestLoc]) div 16; 754 end; // no enemy city or unit here 755 756 if TestScore > 0 then 757 begin 758 TestScore := TestScore * $1000 - DistanceScore * TestTime; 759 if TestScore > PatrolScore then 760 BestCount := 0; 761 if TestScore >= PatrolScore then 762 begin 763 Inc(BestCount); 764 if random(BestCount) = 0 then 765 begin 766 PatrolScore := TestScore; 767 PatrolLoc := TestLoc; 768 end; 769 end; 770 end; 771 end; // while Pile.Get 772 Pile.Free; 773 774 if (PatrolLoc >= 0) and (PatrolLoc <> Loc) then 775 begin // capture/discover/patrol task found, execute it 776 while (PatrolLoc <> Loc) and (MoreTurn[PatrolLoc] > 0) and 777 ((MoreTurn[PatrolLoc] > 1) or not (Map[PatrolLoc] and fTerrain in 778 [fMountains, fDesert, fArctic])) do 779 begin 780 PatrolLoc := PreLoc[PatrolLoc]; 781 done := True; // no effect if enemy spotted 782 end; 783 while (PatrolLoc <> Loc) and (UnitPresence[PatrolLoc] and Kind <> 0) and 784 (Map[PatrolLoc] and fCity = 0) and (Map[PatrolLoc] and fTerImp <> tiFort) and 785 (Map[PatrolLoc] and fTerImp <> tiBase) and not 786 (Map[PreLoc[PatrolLoc]] and fTerrain in [fDesert, fArctic]) do 787 begin 788 PatrolLoc := PreLoc[PatrolLoc]; 789 done := True; // no effect if enemy spotted 790 end; 791 if PatrolLoc = Loc then 792 exit; 793 TestLoc := PatrolLoc; 794 NextLoc := PreLoc[TestLoc]; 795 while TestLoc <> Loc do 796 begin 797 Temp := TestLoc; 798 TestLoc := NextLoc; 799 NextLoc := PreLoc[TestLoc]; 800 PreLoc[TestLoc] := Temp; 801 end; 802 803 UnitPresence[Loc] := UnitPresence[Loc] and not Kind; 804 // assume unit was only one of kind here 805 while Loc <> PatrolLoc do 806 begin 807 NextLoc := PreLoc[Loc]; 808 MoveResult := Unit_Step(uix, NextLoc); 809 if (MoveResult and (rUnitRemoved or rEnemySpotted) <> 0) or 810 (MoveResult and rExecuted = 0) then 811 begin 812 if MoveResult and rExecuted = 0 then 813 Moved[uix] := True; 814 Result := MoveResult and rEnemySpotted = 0; 815 done := True; 816 break; 817 end; 818 assert(Loc = NextLoc); 819 end; 820 if Loc >= 0 then 821 begin 822 UnitPresence[Loc] := UnitPresence[Loc] or Kind; 823 if Map[Loc] and fCity <> 0 then 824 begin 825 Moved[uix] := True; 826 done := True; // stay in captured city as defender 827 end; 681 828 end; 682 829 end 683 end; // while Pile.Get 684 Pile.Free; 685 686 if (PatrolLoc>=0) and (PatrolLoc<>Loc) then 687 begin // capture/discover/patrol task found, execute it 688 while (PatrolLoc<>Loc) and (MoreTurn[PatrolLoc]>0) 689 and ((MoreTurn[PatrolLoc]>1) 690 or not (Map[PatrolLoc] and fTerrain in [fMountains,fDesert,fArctic])) do 691 begin 692 PatrolLoc:=PreLoc[PatrolLoc]; 693 done:=true // no effect if enemy spotted 694 end; 695 while (PatrolLoc<>Loc) and (UnitPresence[PatrolLoc] and Kind<>0) 696 and (Map[PatrolLoc] and fCity=0) 697 and (Map[PatrolLoc] and fTerImp<>tiFort) 698 and (Map[PatrolLoc] and fTerImp<>tiBase) 699 and not (Map[PreLoc[PatrolLoc]] and fTerrain in [fDesert,fArctic]) do 700 begin 701 PatrolLoc:=PreLoc[PatrolLoc]; 702 done:=true // no effect if enemy spotted 703 end; 704 if PatrolLoc=Loc then exit; 705 TestLoc:=PatrolLoc; 706 NextLoc:=PreLoc[TestLoc]; 707 while TestLoc<>Loc do 708 begin 709 Temp:=TestLoc; 710 TestLoc:=NextLoc; 711 NextLoc:=PreLoc[TestLoc]; 712 PreLoc[TestLoc]:=Temp; 713 end; 714 715 UnitPresence[Loc]:=UnitPresence[Loc] and not Kind; // assume unit was only one of kind here 716 while Loc<>PatrolLoc do 717 begin 718 NextLoc:=PreLoc[Loc]; 719 MoveResult:=Unit_Step(uix, NextLoc); 720 if (MoveResult and (rUnitRemoved or rEnemySpotted)<>0) 721 or (MoveResult and rExecuted=0) then 722 begin 723 if MoveResult and rExecuted=0 then Moved[uix]:=true; 724 result:= MoveResult and rEnemySpotted=0; 725 done:=true; 726 break 727 end; 728 assert(Loc=NextLoc); 729 end; 730 if Loc>=0 then 731 begin 732 UnitPresence[Loc]:=UnitPresence[Loc] or Kind; 733 if Map[Loc] and fCity<>0 then 734 begin 735 Moved[uix]:=true; 736 done:=true; // stay in captured city as defender 737 end 738 end 739 end 740 else done:=true; 741 end; // while not done 742 if result then Moved[uix]:=true; 830 else 831 done := True; 832 end; // while not done 833 if Result then 834 Moved[uix] := True; 743 835 end; // ProcessMove 744 836 … … 747 839 procedure SetCityDefenders; 748 840 var 749 uix,cix,V8,Loc1,Best,uixBest,det: integer;750 Adjacent: TVicinity8Loc;751 IsPort: boolean;841 uix, cix, V8, Loc1, Best, uixBest, det: integer; 842 Adjacent: TVicinity8Loc; 843 IsPort: boolean; 752 844 begin 753 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 845 for cix := 0 to RO.nCity - 1 do 846 with MyCity[cix] do 847 if Loc >= 0 then 848 begin 849 IsPort := False; 850 V8_to_Loc(Loc, Adjacent); 851 for V8 := 0 to 7 do 852 begin 853 Loc1 := Adjacent[V8]; 854 if (Loc1 >= 0) and (Map[Loc1] and fTerrain < fGrass) and 855 (Formation[Loc1] >= 0) and (Formation[Loc1] < maxCOD) and 856 (OceanPresence[Formation[Loc1]] and not Neighbours <> 0) then 857 IsPort := True; 858 end; 859 Best := -1; 860 for uix := 0 to RO.nUn - 1 do 861 if MyUnit[uix].Loc = Loc then 862 with MyUnit[uix] do 863 if (MyModel[mix].Domain = dGround) and (MyModel[mix].Attack > 0) then 864 begin 865 if (mix = 2) and (RO.Government = gDespotism) then 866 begin 867 det := 1 shl 16; 868 Moved[uix] := True; 869 end // town guard 870 else if IsPort then 871 det := MyModel[mix].Defense shl 8 + Flags and 872 unFortified shl 7 - health 873 else 874 det := MyModel[mix].Speed shl 8 + Flags and 875 unFortified shl 7 - health; 876 if det > Best then 877 begin 878 Best := det; 879 uixBest := uix; 880 end; 881 end; 882 if Best >= 0 then 883 Moved[uixBest] := True; 884 end; 885 end; 886 887 procedure ProcessSeaTransport; 888 var 889 i, f, uix, Loc1, a, b: integer; 890 ready, go: boolean; 891 TransportPlan: TGroupTransportPlan; 892 begin 893 go := False; 894 for f := 0 to maxCOD - 1 do 895 if (f < nContinent) and (ContinentPresence[f] and not 896 (1 shl me or PresenceUnknown) <> 0) then 897 go := True; // any enemy island known? 898 if not go then 899 exit; 900 901 SeaTransport_BeginInitialize; 902 go := False; 903 for uix := 0 to RO.nUn - 1 do 904 if not Moved[uix] then 905 with MyUnit[uix] do 906 if (Loc >= 0) and (MyModel[mix].Domain = dGround) and 907 (MyModel[mix].Attack > 0) and (Map[Loc] and fTerrain >= fGrass) then 908 begin 909 f := Formation[Loc]; 910 if (f >= 0) and (f < maxCOD) and (ContinentPresence[f] and 911 not (1 shl me) = 0) then 912 begin 913 go := True; 914 SeaTransport_AddLoad(uix); 915 end; 916 end; 917 if go then 754 918 begin 755 IsPort:=false; 756 V8_to_Loc(Loc,Adjacent); 757 for V8:=0 to 7 do 758 begin 759 Loc1:=Adjacent[V8]; 760 if (Loc1>=0) and (Map[Loc1] and fTerrain<fGrass) 761 and (Formation[Loc1]>=0) and (Formation[Loc1]<maxCOD) 762 and (OceanPresence[Formation[Loc1]] and not Neighbours<>0) then 763 IsPort:=true 764 end; 765 Best:=-1; 766 for uix:=0 to RO.nUn-1 do if MyUnit[uix].Loc=Loc then 767 with MyUnit[uix] do 768 if (MyModel[mix].Domain=dGround) and (MyModel[mix].Attack>0) then 769 begin 770 if (mix=2) and (RO.Government=gDespotism) then 771 begin det:=1 shl 16; Moved[uix]:=true end // town guard 772 else if IsPort then det:=MyModel[mix].Defense shl 8+Flags and unFortified shl 7-health 773 else det:=MyModel[mix].Speed shl 8+Flags and unFortified shl 7-health; 774 if det>Best then 775 begin Best:=det; uixBest:=uix end 776 end; 777 if Best>=0 then Moved[uixBest]:=true 919 go := False; 920 for uix := 0 to RO.nUn - 1 do 921 if not Moved[uix] then 922 with MyUnit[uix] do 923 if (Loc >= 0) and (mix = mixBest[ctSeaTrans]) and 924 (TroopLoad = 0) and (Health = 100) then 925 begin 926 go := True; 927 SeaTransport_AddTransport(uix); 928 end; 929 end; 930 if go then 931 for Loc1 := 0 to MapSize - 1 do 932 if Map[Loc1] and fTerrain >= fGrass then 933 begin 934 f := Formation[Loc1]; 935 if (f >= 0) and (f < maxCOD) and (ContinentPresence[f] and 936 not (1 shl me or PresenceUnknown) <> 0) then 937 SeaTransport_AddDestination(Loc1); 938 end; 939 SeaTransport_EndInitialize; 940 while SeaTransport_MakeGroupPlan(TransportPlan) do 941 begin 942 Moved[TransportPlan.uixTransport] := True; 943 ready := MyUnit[TransportPlan.uixTransport].Loc = TransportPlan.LoadLoc; 944 if not ready then 945 begin 946 Unit_MoveEx(TransportPlan.uixTransport, TransportPlan.LoadLoc); 947 ready := MyUnit[TransportPlan.uixTransport].Loc = TransportPlan.LoadLoc; 948 end; 949 if ready then 950 for i := 0 to TransportPlan.nLoad - 1 do 951 begin 952 Loc_to_ab(TransportPlan.LoadLoc, 953 MyUnit[TransportPlan.uixLoad[i]].Loc, a, b); 954 ready := ready and (abs(a) <= 1) and (abs(b) <= 1); 955 end; 956 if ready then 957 begin 958 for i := 0 to TransportPlan.nLoad - 1 do 959 begin 960 Unit_Step(TransportPlan.uixLoad[i], TransportPlan.LoadLoc); 961 Moved[TransportPlan.uixLoad[i]] := True; 962 end; 963 end 964 else 965 begin 966 for i := 0 to TransportPlan.nLoad - 1 do 967 begin 968 Unit_MoveEx(TransportPlan.uixLoad[i], TransportPlan.LoadLoc, mxAdjacent); 969 Moved[TransportPlan.uixLoad[i]] := True; 970 end; 971 end; 778 972 end; 779 973 end; 780 974 781 procedure ProcessSeaTransport;782 var783 i,f,uix,Loc1,a,b: integer;784 ready,go: boolean;785 TransportPlan: TGroupTransportPlan;786 begin787 go:=false;788 for f:=0 to maxCOD-1 do789 if (f<nContinent) and (ContinentPresence[f] and not (1 shl me or PresenceUnknown)<>0) then790 go:=true; // any enemy island known?791 if not go then exit;792 793 SeaTransport_BeginInitialize;794 go:=false;795 for uix:=0 to RO.nUn-1 do if not Moved[uix] then with MyUnit[uix] do796 if (Loc>=0) and (MyModel[mix].Domain=dGround)797 and (MyModel[mix].Attack>0) and (Map[Loc] and fTerrain>=fGrass) then798 begin799 f:=Formation[Loc];800 if (f>=0) and (f<maxCOD) and (ContinentPresence[f] and not (1 shl me)=0) then801 begin go:=true; SeaTransport_AddLoad(uix); end;802 end;803 if go then804 begin805 go:=false;806 for uix:=0 to RO.nUn-1 do if not Moved[uix] then with MyUnit[uix] do807 if (Loc>=0) and (mix=mixBest[ctSeaTrans]) and (TroopLoad=0)808 and (Health=100) then809 begin go:=true; SeaTransport_AddTransport(uix) end;810 end;811 if go then812 for Loc1:=0 to MapSize-1 do if Map[Loc1] and fTerrain>=fGrass then813 begin814 f:=Formation[Loc1];815 if (f>=0) and (f<maxCOD)816 and (ContinentPresence[f] and not (1 shl me or PresenceUnknown)<>0) then817 SeaTransport_AddDestination(Loc1);818 end;819 SeaTransport_EndInitialize;820 while SeaTransport_MakeGroupPlan(TransportPlan) do821 begin822 Moved[TransportPlan.uixTransport]:=true;823 ready:=MyUnit[TransportPlan.uixTransport].Loc=TransportPlan.LoadLoc;824 if not ready then825 begin826 Unit_MoveEx(TransportPlan.uixTransport, TransportPlan.LoadLoc);827 ready:=MyUnit[TransportPlan.uixTransport].Loc=TransportPlan.LoadLoc;828 end;829 if ready then830 for i:=0 to TransportPlan.nLoad-1 do831 begin832 Loc_to_ab(TransportPlan.LoadLoc,833 MyUnit[TransportPlan.uixLoad[i]].Loc, a, b);834 ready:=ready and (abs(a)<=1) and (abs(b)<=1);835 end;836 if ready then837 begin838 for i:=0 to TransportPlan.nLoad-1 do839 begin840 Unit_Step(TransportPlan.uixLoad[i], TransportPlan.LoadLoc);841 Moved[TransportPlan.uixLoad[i]]:=true;842 end843 end844 else845 begin846 for i:=0 to TransportPlan.nLoad-1 do847 begin848 Unit_MoveEx(TransportPlan.uixLoad[i], TransportPlan.LoadLoc, mxAdjacent);849 Moved[TransportPlan.uixLoad[i]]:=true;850 end851 end;852 end853 end;854 855 975 procedure ProcessUnload(uix: integer); 856 976 857 977 procedure Unload(Kind, ToLoc: integer); 858 978 var 859 uix1: integer;979 uix1: integer; 860 980 begin 861 for uix1:=0 to RO.nUn-1 do with MyUnit[uix1] do 862 if (Loc>=0) and (Master=uix) 863 and (MyModel[mix].Domain=dGround) and (MyModel[mix].Attack>0) 864 and (Movement=MyModel[mix].Speed) 865 and ((MyModel[mix].Speed>=250)=(Kind=ukFast)) then 866 begin 867 Unit_Step(uix1,ToLoc); 868 UnitPresence[ToLoc]:=UnitPresence[ToLoc] or Kind; 869 break 981 for uix1 := 0 to RO.nUn - 1 do 982 with MyUnit[uix1] do 983 if (Loc >= 0) and (Master = uix) and (MyModel[mix].Domain = dGround) and 984 (MyModel[mix].Attack > 0) and (Movement = MyModel[mix].Speed) and 985 ((MyModel[mix].Speed >= 250) = (Kind = ukFast)) then 986 begin 987 Unit_Step(uix1, ToLoc); 988 UnitPresence[ToLoc] := UnitPresence[ToLoc] or Kind; 989 break; 990 end; 991 end; 992 993 var 994 uix1, MoveStyle, TestLoc, TestTime, NextLoc, NextTime, V8, 995 RecoverTurns, nSlow, nFast, SlowUnloadLoc, FastUnloadLoc, EndLoc, f: integer; 996 NextTile: cardinal; 997 Adjacent: TVicinity8Loc; 998 Reached: array[0..lxmax * lymax - 1] of boolean; 999 begin 1000 // inventory 1001 nSlow := 0; 1002 nFast := 0; 1003 for uix1 := 0 to RO.nUn - 1 do 1004 with MyUnit[uix1] do 1005 if (Loc >= 0) and (Master = uix) and (MyModel[mix].Domain = dGround) and 1006 (MyModel[mix].Attack > 0) then 1007 if MyModel[mix].Speed >= 250 then 1008 Inc(nFast) 1009 else 1010 Inc(nSlow); 1011 1012 with MyUnit[uix] do 1013 begin 1014 MoveStyle := GetMyMoveStyle(mix, Health); 1015 repeat 1016 SlowUnloadLoc := -1; 1017 FastUnloadLoc := -1; 1018 EndLoc := -1; 1019 fillchar(Reached, MapSize, False); 1020 Pile.Create(MapSize); 1021 Pile.Put(Loc, $800 - Movement); 1022 while (SlowUnloadLoc < 0) and (FastUnloadLoc < 0) and 1023 Pile.Get(TestLoc, TestTime) do 1024 begin 1025 Reached[TestLoc] := True; 1026 V8_to_Loc(TestLoc, Adjacent); 1027 for V8 := 0 to 7 do 1028 begin 1029 NextLoc := Adjacent[V8]; 1030 if (NextLoc >= 0) and not Reached[NextLoc] then 1031 begin 1032 NextTile := Map[NextLoc]; 1033 if NextTile and fTerrain = fUnknown then 1034 else if NextTile and fTerrain >= fGrass then 1035 begin 1036 f := Formation[NextLoc]; 1037 if (f >= 0) and (f < maxCOD) and 1038 (ContinentPresence[f] and not (1 shl me or PresenceUnknown) <> 0) and 1039 (NextTile and (fUnit or fOwned) <> fUnit) then 1040 begin 1041 if (nSlow > 0) and (UnitPresence[NextLoc] and 1042 ukSlow = 0) and ((SlowUnloadLoc < 0) or 1043 (Terrain[Map[NextLoc] and fTerrain].Defense > 1044 Terrain[Map[SlowUnloadLoc] and fTerrain].Defense)) then 1045 begin 1046 EndLoc := TestLoc; 1047 SlowUnloadLoc := NextLoc; 1048 end; 1049 if (nFast > 0) and (UnitPresence[NextLoc] and 1050 ukFast = 0) and ((FastUnloadLoc < 0) or 1051 (Terrain[Map[NextLoc] and fTerrain].Defense > 1052 Terrain[Map[FastUnloadLoc] and fTerrain].Defense)) then 1053 begin 1054 EndLoc := TestLoc; 1055 FastUnloadLoc := NextLoc; 1056 end; 1057 end; 1058 end 1059 else if EndLoc < 0 then 1060 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 1061 RecoverTurns, Map[TestLoc], NextTile, True) of 1062 csOk: 1063 Pile.Put(NextLoc, NextTime); 1064 csForbiddenTile: 1065 Reached[NextLoc] := True; // don't check moving there again 1066 csCheckTerritory: 1067 if RO.Territory[NextLoc] = RO.Territory[TestLoc] then 1068 Pile.Put(NextLoc, NextTime); 1069 end; 1070 end; 1071 end; 1072 end; 1073 Pile.Free; 1074 1075 if EndLoc < 0 then 1076 exit; 1077 if Loc <> EndLoc then 1078 Unit_MoveEx(uix, EndLoc); 1079 if Loc <> EndLoc then 1080 exit; 1081 if SlowUnloadLoc >= 0 then 1082 begin 1083 Unload(ukSlow, SlowUnloadLoc); 1084 Dec(nSlow); 1085 end; 1086 if FastUnloadLoc >= 0 then 1087 begin 1088 Unload(ukFast, FastUnloadLoc); 1089 Dec(nFast); 1090 end; 1091 if TroopLoad = 0 then 1092 begin 1093 Moved[uix] := False; 1094 exit; 870 1095 end 1096 until False; 871 1097 end; 872 873 var 874 uix1,MoveStyle,TestLoc,TestTime,NextLoc,NextTime,V8, 875 RecoverTurns,nSlow,nFast,SlowUnloadLoc,FastUnloadLoc,EndLoc,f: integer; 876 NextTile: cardinal; 877 Adjacent: TVicinity8Loc; 878 Reached: array[0..lxmax*lymax-1] of boolean; 879 begin 880 // inventory 881 nSlow:=0; 882 nFast:=0; 883 for uix1:=0 to RO.nUn-1 do with MyUnit[uix1] do 884 if (Loc>=0) and (Master=uix) 885 and (MyModel[mix].Domain=dGround) and (MyModel[mix].Attack>0) then 886 if MyModel[mix].Speed>=250 then inc(nFast) 887 else inc(nSlow); 888 889 with MyUnit[uix] do 1098 end; 1099 1100 var 1101 uix, euix, Kind, euixBest, AttackLoc: integer; 1102 OldTile: cardinal; 1103 BackToStart, FirstLoop: boolean; 1104 begin 1105 fillchar(UnitPresence, MapSize, 0); 1106 for uix := 0 to RO.nUn - 1 do 1107 with MyUnit[uix] do 1108 if (Loc >= 0) and (MyModel[mix].Domain = dGround) and 1109 (MyModel[mix].Attack > 0) then 1110 begin 1111 if MyModel[mix].Speed >= 250 then 1112 Kind := ukFast 1113 else 1114 Kind := ukSlow; 1115 UnitPresence[Loc] := UnitPresence[Loc] or Kind; 1116 end; 1117 1118 fillchar(Moved, RO.nUn, False); 1119 for uix := 0 to RO.nUn - 1 do 1120 if (MyUnit[uix].Master >= 0) or (MyUnit[uix].TroopLoad > 0) then 1121 Moved[uix] := True; 1122 1123 FirstLoop := True; 1124 repeat 1125 // ATTACK 1126 repeat 1127 BackToStart := False; 1128 if RO.nEnemyUn > 0 then 1129 begin 1130 fillchar(euixMap, MapSize * 2, $FF); 1131 fillchar(AttackScore, RO.nEnemyUn * 4, 0); 1132 for euix := 0 to RO.nEnemyUn - 1 do 1133 with RO.EnemyUn[euix] do 1134 if (Loc >= 0) and (RO.Treaty[Owner] < trPeace) then 1135 begin 1136 BackToStart := True; 1137 euixMap[Loc] := euix; 1138 uixAttack[euix] := -1; 1139 end; 1140 end; 1141 if not BackToStart then 1142 break; 1143 1144 for uix := 0 to RO.nUn - 1 do 1145 with MyUnit[uix] do 1146 if (Loc >= 0) and (Master < 0) and (MyModel[mix].Attack > 0) then 1147 RateAttack(uix); 1148 1149 BackToStart := False; 1150 repeat 1151 euixBest := -1; 1152 for euix := 0 to RO.nEnemyUn - 1 do 1153 if (AttackScore[euix] > 0) and ((euixBest < 0) or 1154 (AttackScore[euix] > AttackScore[euixBest])) then 1155 euixBest := euix; 1156 if euixBest < 0 then 1157 break; 1158 uix := uixAttack[euixBest]; 1159 AttackLoc := RO.EnemyUn[euixBest].Loc; 1160 OldTile := Map[AttackLoc]; 1161 if (AttackLoc < 0) 1162 // only happens when city was destroyd with attack and enemy units have disappeared 1163 or (DoAttack(uix, AttackLoc) and 1164 ((Map[AttackLoc] and fUnit <> 0) or (OldTile and fCity <> 0) and 1165 (Map[AttackLoc] and fCity = 0))) then 1166 BackToStart := True // new situation, rethink 1167 else 1168 begin 1169 euixMap[AttackLoc] := -1; 1170 AttackScore[euixBest] := 0; 1171 uixAttack[euixBest] := -1; 1172 if MyUnit[uix].Loc >= 0 then 1173 RateAttack(uix); 1174 end 1175 until BackToStart 1176 until not BackToStart; 1177 1178 if FirstLoop then 890 1179 begin 891 MoveStyle:=GetMyMoveStyle(mix, Health); 892 repeat 893 SlowUnloadLoc:=-1; 894 FastUnloadLoc:=-1; 895 EndLoc:=-1; 896 fillchar(Reached, MapSize, false); 897 Pile.Create(MapSize); 898 Pile.Put(Loc, $800-Movement); 899 while (SlowUnloadLoc<0) and (FastUnloadLoc<0) 900 and Pile.Get(TestLoc, TestTime) do 901 begin 902 Reached[TestLoc]:=true; 903 V8_to_Loc(TestLoc, Adjacent); 904 for V8:=0 to 7 do 905 begin 906 NextLoc:=Adjacent[V8]; 907 if (NextLoc>=0) and not Reached[NextLoc] then 1180 SetCityDefenders; 1181 ProcessSeaTransport; 1182 for uix := 0 to RO.nUn - 1 do 1183 with MyUnit[uix] do 1184 if (Loc >= 0) and (TroopLoad > 0) then 1185 ProcessUnload(uix); 1186 end; 1187 FirstLoop := False; 1188 1189 for uix := 0 to RO.nUn - 1 do 1190 with MyUnit[uix], MyModel[mix] do 1191 if not Moved[uix] and (Loc >= 0) and (Domain = dSea) and 1192 (Attack > 0) and (Cap[mcArtillery] > 0) then 1193 DoAttack(uix, maNextCity); // check bombardments 1194 1195 // MOVE 1196 for uix := 0 to RO.nUn - 1 do 1197 if not Moved[uix] then 1198 with MyUnit[uix] do 1199 if (Loc >= 0) and ((MyModel[mix].Attack > 0) or 1200 (MyModel[mix].Domain = dSea)) then 1201 if not ProcessMove(uix) then 908 1202 begin 909 NextTile:=Map[NextLoc]; 910 if NextTile and fTerrain=fUnknown then 911 else if NextTile and fTerrain>=fGrass then 912 begin 913 f:=Formation[NextLoc]; 914 if (f>=0) and (f<maxCOD) 915 and (ContinentPresence[f] and not (1 shl me or PresenceUnknown)<>0) 916 and (NextTile and (fUnit or fOwned)<>fUnit) then 917 begin 918 if (nSlow>0) and (UnitPresence[NextLoc] and ukSlow=0) 919 and ((SlowUnloadLoc<0) or (Terrain[Map[NextLoc] and fTerrain].Defense 920 >Terrain[Map[SlowUnloadLoc] and fTerrain].Defense)) then 921 begin EndLoc:=TestLoc; SlowUnloadLoc:=NextLoc end; 922 if (nFast>0) and (UnitPresence[NextLoc] and ukFast=0) 923 and ((FastUnloadLoc<0) or (Terrain[Map[NextLoc] and fTerrain].Defense 924 >Terrain[Map[FastUnloadLoc] and fTerrain].Defense)) then 925 begin EndLoc:=TestLoc; FastUnloadLoc:=NextLoc end; 926 end 927 end 928 else if EndLoc<0 then 929 case CheckStep(MoveStyle, TestTime, V8 and 1, NextTime, 930 RecoverTurns, Map[TestLoc], NextTile, true) of 931 csOk: 932 Pile.Put(NextLoc, NextTime); 933 csForbiddenTile: 934 Reached[NextLoc]:=true; // don't check moving there again 935 csCheckTerritory: 936 if RO.Territory[NextLoc]=RO.Territory[TestLoc] then 937 Pile.Put(NextLoc, NextTime); 938 end 1203 BackToStart := True; 1204 break; 939 1205 end 940 end;941 end;942 Pile.Free;943 944 if EndLoc<0 then exit;945 if Loc<>EndLoc then946 Unit_MoveEx(uix,EndLoc);947 if Loc<>EndLoc then exit;948 if SlowUnloadLoc>=0 then949 begin Unload(ukSlow,SlowUnloadLoc); dec(nSlow) end;950 if FastUnloadLoc>=0 then951 begin Unload(ukFast,FastUnloadLoc); dec(nFast) end;952 if TroopLoad=0 then953 begin Moved[uix]:=false; exit end954 until false955 end956 end;957 958 var959 uix,euix,Kind,euixBest,AttackLoc: integer;960 OldTile: cardinal;961 BackToStart,FirstLoop: boolean;962 begin963 fillchar(UnitPresence, MapSize, 0);964 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do965 if (Loc>=0) and (MyModel[mix].Domain=dGround) and (MyModel[mix].Attack>0) then966 begin967 if MyModel[mix].Speed>=250 then Kind:=ukFast968 else Kind:=ukSlow;969 UnitPresence[Loc]:=UnitPresence[Loc] or Kind970 end;971 972 fillchar(Moved, RO.nUn, false);973 for uix:=0 to RO.nUn-1 do974 if (MyUnit[uix].Master>=0) or (MyUnit[uix].TroopLoad>0) then975 Moved[uix]:=true;976 977 FirstLoop:=true;978 repeat979 // ATTACK980 repeat981 BackToStart:=false;982 if RO.nEnemyUn>0 then983 begin984 fillchar(euixMap, MapSize*2, $FFFF);985 fillchar(AttackScore,RO.nEnemyUn*4,0);986 for euix:=0 to RO.nEnemyUn-1 do with RO.EnemyUn[euix] do987 if (Loc>=0) and (RO.Treaty[Owner]<trPeace) then988 begin989 BackToStart:=true;990 euixMap[Loc]:=euix;991 uixAttack[euix]:=-1;992 end;993 end;994 if not BackToStart then break;995 996 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do997 if (Loc>=0) and (Master<0) and (MyModel[mix].Attack>0) then998 RateAttack(uix);999 1000 BackToStart:=false;1001 repeat1002 euixBest:=-1;1003 for euix:=0 to RO.nEnemyUn-1 do1004 if (AttackScore[euix]>0)1005 and ((euixBest<0) or (AttackScore[euix]>AttackScore[euixBest])) then1006 euixBest:=euix;1007 if euixBest<0 then break;1008 uix:=uixAttack[euixBest];1009 AttackLoc:=RO.EnemyUn[euixBest].Loc;1010 OldTile:=Map[AttackLoc];1011 if (AttackLoc<0) // only happens when city was destroyd with attack and enemy units have disappeared1012 or (DoAttack(uix,AttackLoc)1013 and ((Map[AttackLoc] and fUnit<>0)1014 or (OldTile and fCity<>0) and (Map[AttackLoc] and fCity=0))) then1015 BackToStart:=true // new situation, rethink1016 else1017 begin1018 euixMap[AttackLoc]:=-1;1019 AttackScore[euixBest]:=0;1020 uixAttack[euixBest]:=-1;1021 if MyUnit[uix].Loc>=0 then1022 RateAttack(uix);1023 end1024 until BackToStart1025 1206 until not BackToStart; 1026 1027 if FirstLoop then1028 begin1029 SetCityDefenders;1030 ProcessSeaTransport;1031 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do1032 if (Loc>=0) and (TroopLoad>0) then1033 ProcessUnload(uix);1034 end;1035 FirstLoop:=false;1036 1037 for uix:=0 to RO.nUn-1 do with MyUnit[uix],MyModel[mix] do1038 if not Moved[uix] and (Loc>=0) and (Domain=dSea) and (Attack>0)1039 and (Cap[mcArtillery]>0) then1040 DoAttack(uix,maNextCity); // check bombardments1041 1042 // MOVE1043 for uix:=0 to RO.nUn-1 do if not Moved[uix] then with MyUnit[uix] do1044 if (Loc>=0) and ((MyModel[mix].Attack>0) or (MyModel[mix].Domain=dSea)) then1045 if not ProcessMove(uix) then1046 begin BackToStart:=true; break end1047 until not BackToStart;1048 1207 end; // AttackAndPatrol 1049 1208 … … 1051 1210 1052 1211 const 1053 CoastalWonder=1 shl woLighthouse + 1 shl woMagellan;1054 PrimeWonder=1 shl woColossus + 1 shl woGrLibrary + 1 shl woSun 1055 +1 shl woMagellan + 1 shl woEiffel + 1 shl woLiberty + 1 shl woShinkansen;1212 CoastalWonder = 1 shl woLighthouse + 1 shl woMagellan; 1213 PrimeWonder = 1 shl woColossus + 1 shl woGrLibrary + 1 shl woSun + 1214 1 shl woMagellan + 1 shl woEiffel + 1 shl woLiberty + 1 shl woShinkansen; 1056 1215 1057 1216 function LowPriority(cix: integer): boolean; 1058 1217 var 1059 part,cixHighPriority,TestDistance: integer;1218 part, cixHighPriority, TestDistance: integer; 1060 1219 begin 1061 result:=false;1062 for part:=0 to nShipPart-1 do1220 Result := False; 1221 for part := 0 to nShipPart - 1 do 1063 1222 begin 1064 cixHighPriority:=ColonyShipPlan[part].cixProducing; 1065 if (cixHighPriority>=0) and (cixHighPriority<>cix) then 1066 begin 1067 TestDistance:=Distance(MyCity[cix].Loc,MyCity[cixHighPriority].Loc); 1068 if TestDistance<11 then 1069 begin result:=true; exit end 1070 end 1071 end 1223 cixHighPriority := ColonyShipPlan[part].cixProducing; 1224 if (cixHighPriority >= 0) and (cixHighPriority <> cix) then 1225 begin 1226 TestDistance := Distance(MyCity[cix].Loc, MyCity[cixHighPriority].Loc); 1227 if TestDistance < 11 then 1228 begin 1229 Result := True; 1230 exit; 1231 end; 1232 end; 1233 end; 1072 1234 end; 1073 1235 1074 1236 function ChooseWonderToBuild(WonderAvailable: integer; AllowCoastal: boolean): integer; 1075 1237 var 1076 Count,iix: integer;1238 Count, iix: integer; 1077 1239 begin 1078 if (WonderAvailable and PrimeWonder>0)1079 and (AllowCoastal or (WonderAvailable and PrimeWonder and not CoastalWonder>0)) then1080 WonderAvailable:=WonderAvailable and PrimeWonder; // alway prefer prime wonders1081 Count:=0;1082 for iix:=0 to 27 do1240 if (WonderAvailable and PrimeWonder > 0) and (AllowCoastal or 1241 (WonderAvailable and PrimeWonder and not CoastalWonder > 0)) then 1242 WonderAvailable := WonderAvailable and PrimeWonder; // alway prefer prime wonders 1243 Count := 0; 1244 for iix := 0 to 27 do 1083 1245 begin 1084 if (1 shl iix) and WonderAvailable<>0 then 1085 if (1 shl iix) and CoastalWonder<>0 then 1086 begin 1087 if AllowCoastal then inc(Count,2) 1246 if (1 shl iix) and WonderAvailable <> 0 then 1247 if (1 shl iix) and CoastalWonder <> 0 then 1248 begin 1249 if AllowCoastal then 1250 Inc(Count, 2); 1088 1251 end 1089 else inc(Count); 1252 else 1253 Inc(Count); 1090 1254 end; 1091 Count:=Random(Count);1092 for iix:=0 to 27 do1255 Count := Random(Count); 1256 for iix := 0 to 27 do 1093 1257 begin 1094 if (1 shl iix) and WonderAvailable<>0 then 1095 if (1 shl iix) and CoastalWonder<>0 then 1096 begin 1097 if AllowCoastal then dec(Count,2) 1258 if (1 shl iix) and WonderAvailable <> 0 then 1259 if (1 shl iix) and CoastalWonder <> 0 then 1260 begin 1261 if AllowCoastal then 1262 Dec(Count, 2); 1098 1263 end 1099 else dec(Count); 1100 if Count<0 then 1101 begin 1102 result:=iix; 1103 exit 1104 end 1105 end 1264 else 1265 Dec(Count); 1266 if Count < 0 then 1267 begin 1268 Result := iix; 1269 exit; 1270 end; 1271 end; 1106 1272 end; 1107 1273 1108 1274 var 1109 i,iix,cix,mix,uix,mixProduce,mixShip,V8,V21,Loc1,TotalPop,AlonePop,f,f1,1110 nTownGuard,ShipPart,ProduceShipPart,TestDistance,part,WonderAvailable,1111 WonderInWork,cixNewCapital,Center,Score,BestScore: integer;1112 mixCount: array[0..nmmax-1] of integer;1113 //RareLoc: array[0..5] of integer;1114 Adjacent: TVicinity8Loc;1115 IsCoastal,IsPort,IsUnitProjectObsolete,HasSettler,SpezializeShipProduction,1116 AlgaeAvailable, ProjectComplete,DoLowPriority,WillProduceColonyShip,1275 i, iix, cix, mix, uix, mixProduce, mixShip, V8, V21, Loc1, TotalPop, 1276 AlonePop, f, f1, nTownGuard, ShipPart, ProduceShipPart, TestDistance, 1277 part, WonderAvailable, WonderInWork, cixNewCapital, Center, Score, BestScore: integer; 1278 mixCount: array[0..nmmax - 1] of integer; 1279 //RareLoc: array[0..5] of integer; 1280 Adjacent: TVicinity8Loc; 1281 IsCoastal, IsPort, IsUnitProjectObsolete, HasSettler, SpezializeShipProduction, 1282 AlgaeAvailable, ProjectComplete, DoLowPriority, WillProduceColonyShip, 1117 1283 ImportantCity: boolean; 1118 Radius: TVicinity21Loc;1119 Report: TCityReportNew;1284 Radius: TVicinity21Loc; 1285 Report: TCityReportNew; 1120 1286 begin 1121 AnalyzeMap; 1122 1123 FindBestModels; 1124 1125 fillchar(mixCount, RO.nModel*4, 0); 1126 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1127 if Loc>=0 then inc(mixCount[mix]); 1128 if (mixBest[ctGroundSlow]>=0) 1129 and ((mixBest[ctGroundFast]<0) 1130 or (mixCount[mixBest[ctGroundSlow]]<mixCount[mixBest[ctGroundFast]])) then 1131 mixProduce:=mixBest[ctGroundSlow] 1132 else mixProduce:=mixBest[ctGroundFast]; 1133 if (mixBest[ctSeaTrans]>=0) 1134 and ((mixBest[ctSeaArt]<0) 1135 or (mixCount[mixBest[ctSeaTrans]]<mixCount[mixBest[ctSeaArt]])) then 1136 mixShip:=mixBest[ctSeaTrans] 1137 else mixShip:=mixBest[ctSeaArt]; 1138 if (mixProduce>=0) and (mixBest[ctSeaTrans]>=0) 1139 and (mixCount[mixShip]*RO.Model[mixBest[ctSeaTrans]].Cap[mcSeaTrans] 1140 *RO.Model[mixBest[ctSeaTrans]].MTrans div 2>=mixCount[mixProduce]) then 1141 mixShip:=-1; 1142 1143 // produce ships only on certain continents? 1144 TotalPop:=0; 1145 AlonePop:=0; 1146 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 1147 if (Loc>=0) and (Flags and chCaptured=0) then 1287 AnalyzeMap; 1288 1289 FindBestModels; 1290 1291 fillchar(mixCount, RO.nModel * 4, 0); 1292 for uix := 0 to RO.nUn - 1 do 1293 with MyUnit[uix] do 1294 if Loc >= 0 then 1295 Inc(mixCount[mix]); 1296 if (mixBest[ctGroundSlow] >= 0) and ((mixBest[ctGroundFast] < 0) or 1297 (mixCount[mixBest[ctGroundSlow]] < mixCount[mixBest[ctGroundFast]])) then 1298 mixProduce := mixBest[ctGroundSlow] 1299 else 1300 mixProduce := mixBest[ctGroundFast]; 1301 if (mixBest[ctSeaTrans] >= 0) and ((mixBest[ctSeaArt] < 0) or 1302 (mixCount[mixBest[ctSeaTrans]] < mixCount[mixBest[ctSeaArt]])) then 1303 mixShip := mixBest[ctSeaTrans] 1304 else 1305 mixShip := mixBest[ctSeaArt]; 1306 if (mixProduce >= 0) and (mixBest[ctSeaTrans] >= 0) and 1307 (mixCount[mixShip] * RO.Model[mixBest[ctSeaTrans]].Cap[mcSeaTrans] * 1308 RO.Model[mixBest[ctSeaTrans]].MTrans div 2 >= mixCount[mixProduce]) then 1309 mixShip := -1; 1310 1311 // produce ships only on certain continents? 1312 TotalPop := 0; 1313 AlonePop := 0; 1314 for cix := 0 to RO.nCity - 1 do 1315 with MyCity[cix] do 1316 if (Loc >= 0) and (Flags and chCaptured = 0) then 1317 begin 1318 Inc(TotalPop, Size); 1319 f := Formation[Loc]; 1320 if (f < 0) or (f >= maxCOD) or (ContinentPresence[f] = 1 shl me) then 1321 Inc(AlonePop, Size); 1322 end; 1323 SpezializeShipProduction := AlonePop * 2 >= TotalPop; 1324 1325 cixNewCapital := -1; 1326 WonderAvailable := 0; 1327 WonderInWork := 0; 1328 for iix := 0 to 27 do 1329 if (Imp[iix].Preq <> preNA) and ((Imp[iix].Preq = preNone) or 1330 IsResearched(Imp[iix].Preq)) and (RO.Wonder[iix].CityID = -1) then 1331 Inc(WonderAvailable, 1 shl iix); 1332 for cix := 0 to RO.nCity - 1 do 1333 if MyCity[cix].Loc >= 0 then 1148 1334 begin 1149 inc(TotalPop, Size); 1150 f:=Formation[Loc]; 1151 if (f<0) or (f>=maxCOD) or (ContinentPresence[f]=1 shl me) then 1152 inc(AlonePop, Size); 1335 iix := City_CurrentImprovementProject(cix); 1336 if (iix >= 0) and (iix < 28) then 1337 Inc(WonderInWork, 1 shl iix) 1338 else if iix = imPalace then 1339 cixNewCapital := cix; 1153 1340 end; 1154 SpezializeShipProduction:= AlonePop*2>=TotalPop; 1155 1156 cixNewCapital:=-1; 1157 WonderAvailable:=0; 1158 WonderInWork:=0; 1159 for iix:=0 to 27 do 1160 if (Imp[iix].Preq<>preNA) 1161 and ((Imp[iix].Preq=preNone) or IsResearched(Imp[iix].Preq)) 1162 and (RO.Wonder[iix].CityID=-1) then 1163 inc(WonderAvailable,1 shl iix); 1164 for cix:=0 to RO.nCity-1 do if MyCity[cix].Loc>=0 then 1165 begin 1166 iix:=City_CurrentImprovementProject(cix); 1167 if (iix>=0) and (iix<28) then 1168 inc(WonderInWork,1 shl iix) 1169 else if iix=imPalace then 1170 cixNewCapital:=cix; 1341 1342 if (RO.NatBuilt[imPalace] = 0) and (cixNewCapital < 0) then 1343 begin // palace was destroyed, build new one 1344 Center := CenterOfEmpire; 1345 BestScore := 0; 1346 for cix := 0 to RO.nCity - 1 do 1347 with MyCity[cix] do 1348 if (Loc >= 0) and (Flags and chCaptured = 0) then 1349 begin // evaluate city as new capital 1350 Score := Size * 12 + 512 - Distance(Loc, Center); 1351 V8_to_Loc(Loc, Adjacent); 1352 for V8 := 0 to 7 do 1353 begin 1354 Loc1 := Adjacent[V8]; 1355 if (Loc1 >= 0) and (Map[Loc1] and fTerrain < fGrass) then 1356 begin 1357 f1 := Formation[Loc1]; 1358 if (f1 >= 0) and (f1 < maxCOD) and 1359 ((OceanSize[f1] >= 8) or (OceanPresence[f1] and not 1360 (1 shl me) <> 0)) then 1361 begin // prefer non-coastal cities 1362 Dec(Score, 18); 1363 break; 1364 end; 1365 end; 1366 end; 1367 if Score > BestScore then 1368 begin 1369 BestScore := Score; 1370 cixNewCapital := cix; 1371 end; 1372 end; 1171 1373 end; 1172 1374 1173 if (RO.NatBuilt[imPalace]=0) and (cixNewCapital<0) then 1174 begin // palace was destroyed, build new one 1175 Center:=CenterOfEmpire; 1176 BestScore:=0; 1177 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 1178 if (Loc>=0) and (Flags and chCaptured=0) then 1179 begin // evaluate city as new capital 1180 Score:=Size*12 + 512-Distance(Loc,Center); 1181 V8_to_Loc(Loc,Adjacent); 1182 for V8:=0 to 7 do 1183 begin 1184 Loc1:=Adjacent[V8]; 1185 if (Loc1>=0) and (Map[Loc1] and fTerrain<fGrass) then 1186 begin 1187 f1:=Formation[Loc1]; 1188 if (f1>=0) and (f1<maxCOD) 1189 and ((OceanSize[f1]>=8) or (OceanPresence[f1] and not (1 shl me)<>0)) then 1190 begin // prefer non-coastal cities 1191 dec(Score,18); 1192 break 1193 end 1375 AlgaeAvailable := (RO.NatBuilt[imAlgae] = 0) and 1376 (RO.Tech[Imp[imAlgae].Preq] >= tsApplicable); 1377 for cix := 0 to RO.nCity - 1 do 1378 with MyCity[cix] do 1379 if (Loc >= 0) and (Project and (cpImp + cpIndex) = cpImp + imAlgae) then 1380 AlgaeAvailable := False; 1381 1382 for cix := 0 to RO.nCity - 1 do 1383 with MyCity[cix] do 1384 if (Loc >= 0) and (Flags and chCaptured = 0) and LowPriority(cix) then 1385 City_SetTiles(cix, 1 shl CityOwnTile); // free all tiles of low-prio cities 1386 for DoLowPriority := False to True do 1387 for cix := 0 to RO.nCity - 1 do 1388 with MyCity[cix] do 1389 if (Loc >= 0) and (Flags and chCaptured = 0) and 1390 (LowPriority(cix) = DoLowPriority) then 1391 begin 1392 f := Formation[Loc]; 1393 IsCoastal := False; 1394 IsPort := False; 1395 V8_to_Loc(Loc, Adjacent); 1396 for V8 := 0 to 7 do 1397 begin 1398 Loc1 := Adjacent[V8]; 1399 if (Loc1 >= 0) and (Map[Loc1] and fTerrain < fGrass) then 1400 begin 1401 IsCoastal := True; 1402 f1 := Formation[Loc1]; 1403 if (f1 >= 0) and (f1 < maxCOD) and (OceanSize[f1] >= 8) and 1404 (OceanPresence[f1] and not (1 shl me) <> 0) then 1405 begin 1406 IsPort := True; 1407 break; 1408 end; 1409 end; 1410 end; 1411 if (City_CurrentUnitProject(cix) >= 0) and 1412 (RO.Model[City_CurrentUnitProject(cix)].Kind <> mkSettler) then 1413 begin 1414 i := nModelCategory - 1; 1415 while (i >= 0) and (City_CurrentUnitProject(cix) <> mixBest[i]) do 1416 Dec(i); 1417 IsUnitProjectObsolete := i < 0; 1194 1418 end 1195 end; 1196 if Score>BestScore then 1197 begin 1198 BestScore:=Score; 1199 cixNewCapital:=cix 1200 end 1201 end 1202 end; 1203 1204 AlgaeAvailable:= (RO.NatBuilt[imAlgae]=0) and (RO.Tech[Imp[imAlgae].Preq]>=tsApplicable); 1205 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 1206 if (Loc>=0) and (Project and (cpImp+cpIndex)=cpImp+imAlgae) then 1207 AlgaeAvailable:=false; 1208 1209 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 1210 if (Loc>=0) and (Flags and chCaptured=0) and LowPriority(cix) then 1211 City_SetTiles(cix,1 shl CityOwnTile); // free all tiles of low-prio cities 1212 for DoLowPriority:=false to true do 1213 for cix:=0 to RO.nCity-1 do with MyCity[cix] do 1214 if (Loc>=0) and (Flags and chCaptured=0) and (LowPriority(cix)=DoLowPriority) then 1215 begin 1216 f:=Formation[Loc]; 1217 IsCoastal:=false; 1218 IsPort:=false; 1219 V8_to_Loc(Loc,Adjacent); 1220 for V8:=0 to 7 do 1221 begin 1222 Loc1:=Adjacent[V8]; 1223 if (Loc1>=0) and (Map[Loc1] and fTerrain<fGrass) then 1224 begin 1225 IsCoastal:=true; 1226 f1:=Formation[Loc1]; 1227 if (f1>=0) and (f1<maxCOD) and (OceanSize[f1]>=8) 1228 and (OceanPresence[f1] and not (1 shl me)<>0) then 1419 else 1420 IsUnitProjectObsolete := False; 1421 if RO.Government = gDespotism then 1422 begin 1423 nTownGuard := 0; 1424 for uix := 0 to RO.nUn - 1 do 1425 if (MyUnit[uix].mix = mixTownGuard) and (MyUnit[uix].Loc = Loc) then 1426 Inc(nTownGuard); 1427 end; 1428 1429 iix := City_CurrentImprovementProject(cix); 1430 if (iix >= 0) and (iix < 28) or (iix = imPalace) or 1431 (iix = imShipComp) or (iix = imShipPow) or (iix = imShipHab) then 1432 City_OptimizeTiles(cix, rwMaxProd) 1433 else if size < 8 then 1434 City_OptimizeTiles(cix, rwMaxGrowth) 1435 else 1436 City_OptimizeTiles(cix, rwForceProd); 1437 1438 WillProduceColonyShip := False; 1439 ProduceShipPart := -1; 1440 for part := 0 to nShipPart - 1 do 1441 if ColonyShipPlan[part].cixProducing = cix then 1229 1442 begin 1230 IsPort:=true; 1231 break; 1232 end 1233 end 1234 end; 1235 if (City_CurrentUnitProject(cix)>=0) 1236 and (RO.Model[City_CurrentUnitProject(cix)].Kind<>mkSettler) then 1237 begin 1238 i:=nModelCategory-1; 1239 while (i>=0) and (City_CurrentUnitProject(cix)<>mixBest[i]) do 1240 dec(i); 1241 IsUnitProjectObsolete:= i<0; 1242 end 1243 else IsUnitProjectObsolete:=false; 1244 if RO.Government=gDespotism then 1245 begin 1246 nTownGuard:=0; 1247 for uix:=0 to RO.nUn-1 do 1248 if (MyUnit[uix].mix=mixTownGuard) and (MyUnit[uix].Loc=Loc) then 1249 inc(nTownGuard); 1250 end; 1251 1252 iix:=City_CurrentImprovementProject(cix); 1253 if (iix>=0) and (iix<28) 1254 or (iix=imPalace) or (iix=imShipComp) or (iix=imShipPow) or (iix=imShipHab) then 1255 City_OptimizeTiles(cix,rwMaxProd) 1256 else if size<8 then 1257 City_OptimizeTiles(cix,rwMaxGrowth) 1258 else City_OptimizeTiles(cix,rwForceProd); 1259 1260 WillProduceColonyShip:=false; 1261 ProduceShipPart:=-1; 1262 for part:=0 to nShipPart-1 do 1263 if ColonyShipPlan[part].cixProducing=cix then 1264 begin 1265 WillProduceColonyShip:=true; 1266 ProduceShipPart:=ShipImpIndex[part]; 1267 end; 1268 1269 if cix=cixNewCapital then 1270 City_StartImprovement(cix,imPalace) 1271 else if (iix>=0) and (iix<28) and ((1 shl iix) and WonderAvailable<>0) then 1272 // complete wonder production first 1273 else if (mixProduce>=0) and (City_CurrentUnitProject(cix)>=0) 1274 and not IsUnitProjectObsolete 1275 and ((Flags and chProduction=0) 1276 or (RO.Model[City_CurrentUnitProject(cix)].Cap[mcLine]>0) 1277 and (mixCount[City_CurrentUnitProject(cix)]<RO.nCity*(2+cix and 3))) then 1278 // complete unit production first 1279 else 1280 begin 1281 if ProduceShipPart>=0 then 1282 begin 1283 if (Built[imGranary]=0) and (Size<10) and City_Improvable(cix,imGranary) then 1284 City_StartImprovement(cix,imGranary) 1285 else if (Built[imAqueduct]=0) and City_Improvable(cix,imAqueduct) then 1286 City_StartImprovement(cix,imAqueduct) 1287 else if (Built[imAqueduct]>0) and (Size<12) 1288 and (AlgaeAvailable or (Project and (cpImp+cpIndex)=cpImp+imAlgae)) then 1289 City_StartImprovement(cix,imAlgae) 1290 else if (Built[imFactory]=0) and City_Improvable(cix,imFactory) then 1291 City_StartImprovement(cix,imFactory) 1292 else if (Built[imPower]+Built[imHydro]+Built[imNuclear]=0) 1293 and (City_Improvable(cix,imPower) 1294 or City_Improvable(cix,imHydro) 1295 or City_Improvable(cix,imNuclear)) then 1443 WillProduceColonyShip := True; 1444 ProduceShipPart := ShipImpIndex[part]; 1445 end; 1446 1447 if cix = cixNewCapital then 1448 City_StartImprovement(cix, imPalace) 1449 else if (iix >= 0) and (iix < 28) and ((1 shl iix) and 1450 WonderAvailable <> 0) then 1451 // complete wonder production first 1452 else if (mixProduce >= 0) and (City_CurrentUnitProject(cix) >= 0) and 1453 not IsUnitProjectObsolete and ((Flags and chProduction = 0) or 1454 (RO.Model[City_CurrentUnitProject(cix)].Cap[mcLine] > 0) and 1455 (mixCount[City_CurrentUnitProject(cix)] < RO.nCity * (2 + cix and 3))) then 1456 // complete unit production first 1457 else 1458 begin 1459 if ProduceShipPart >= 0 then 1296 1460 begin 1297 if City_Improvable(cix,imHydro) then 1298 City_StartImprovement(cix,imHydro) 1299 else if City_Improvable(cix,imPower) then 1300 City_StartImprovement(cix,imPower) 1301 else City_StartImprovement(cix,imNuclear) 1302 end 1303 else if (Built[imMfgPlant]=0) and City_Improvable(cix,imMfgPlant) then 1304 City_StartImprovement(cix,imMfgPlant) 1305 else if City_Improvable(cix, ProduceShipPart) then 1306 City_StartImprovement(cix,ProduceShipPart) 1307 else ProduceShipPart:=-1; 1308 end; 1309 if ProduceShipPart<0 then 1310 begin 1311 ProjectComplete:= not City_HasProject(cix) or (Flags and chProduction<>0); 1312 HasSettler:=false; 1313 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1314 if (Loc>=0) and (Home=cix) 1315 and (MyModel[mix].Kind=mkSettler) then 1316 HasSettler:=true; 1317 if ((RO.Government<>gDespotism) or (RO.nUn>=RO.nCity*4)) 1318 and not IsResearched(adMassProduction) 1319 and (Built[imPalace]>0) and (RO.Wonder[woZeus].CityID=-1) 1320 and City_Improvable(cix,woZeus) then 1321 City_StartImprovement(cix,woZeus) 1322 else if (City_CurrentImprovementProject(cix)>=0) 1323 and (City_CurrentImprovementProject(cix)<28) then 1324 begin// wonder already built, try to switch to different one 1325 if (WonderAvailable and not WonderInWork>0) 1326 and (IsCoastal or (WonderAvailable and not WonderInWork and not CoastalWonder>0)) then 1461 if (Built[imGranary] = 0) and (Size < 10) and 1462 City_Improvable(cix, imGranary) then 1463 City_StartImprovement(cix, imGranary) 1464 else if (Built[imAqueduct] = 0) and City_Improvable(cix, imAqueduct) then 1465 City_StartImprovement(cix, imAqueduct) 1466 else if (Built[imAqueduct] > 0) and (Size < 12) and 1467 (AlgaeAvailable or (Project and (cpImp + cpIndex) = 1468 cpImp + imAlgae)) then 1469 City_StartImprovement(cix, imAlgae) 1470 else if (Built[imFactory] = 0) and City_Improvable(cix, imFactory) then 1471 City_StartImprovement(cix, imFactory) 1472 else if (Built[imPower] + Built[imHydro] + Built[imNuclear] = 0) and 1473 (City_Improvable(cix, imPower) or 1474 City_Improvable(cix, imHydro) or City_Improvable(cix, imNuclear)) then 1327 1475 begin 1328 iix:=ChooseWonderToBuild(WonderAvailable and not WonderInWork,IsCoastal); 1329 City_StartImprovement(cix,iix); 1330 WonderInWork:=WonderInWork or (1 shl iix); 1476 if City_Improvable(cix, imHydro) then 1477 City_StartImprovement(cix, imHydro) 1478 else if City_Improvable(cix, imPower) then 1479 City_StartImprovement(cix, imPower) 1480 else 1481 City_StartImprovement(cix, imNuclear); 1331 1482 end 1332 else City_StopProduction(cix); 1333 end 1334 else if (Built[imPalace]>0) and (RO.NatBuilt[imSpacePort]=0) 1335 and City_Improvable(cix,imSpacePort) then 1336 City_StartImprovement(cix,imSpacePort) 1337 else if Built[imPalace]+Built[imCourt]+Built[imTownHall]=0 then 1483 else if (Built[imMfgPlant] = 0) and City_Improvable(cix, imMfgPlant) then 1484 City_StartImprovement(cix, imMfgPlant) 1485 else if City_Improvable(cix, ProduceShipPart) then 1486 City_StartImprovement(cix, ProduceShipPart) 1487 else 1488 ProduceShipPart := -1; 1489 end; 1490 if ProduceShipPart < 0 then 1338 1491 begin 1339 if City_Improvable(cix,imCourt) then 1340 City_StartImprovement(cix,imCourt) 1341 else City_StartImprovement(cix,imTownHall); 1342 end 1343 else if not HasSettler and (RO.nUn>=RO.nCity*4) then 1344 begin 1345 if ProjectComplete and (City_CurrentUnitProject(cix)<>0) then 1492 ProjectComplete := 1493 not City_HasProject(cix) or (Flags and chProduction <> 0); 1494 HasSettler := False; 1495 for uix := 0 to RO.nUn - 1 do 1496 with MyUnit[uix] do 1497 if (Loc >= 0) and (Home = cix) and 1498 (MyModel[mix].Kind = mkSettler) then 1499 HasSettler := True; 1500 if ((RO.Government <> gDespotism) or (RO.nUn >= RO.nCity * 4)) and 1501 not IsResearched(adMassProduction) and (Built[imPalace] > 0) and 1502 (RO.Wonder[woZeus].CityID = -1) and City_Improvable(cix, woZeus) then 1503 City_StartImprovement(cix, woZeus) 1504 else if (City_CurrentImprovementProject(cix) >= 0) and 1505 (City_CurrentImprovementProject(cix) < 28) then 1506 begin// wonder already built, try to switch to different one 1507 if (WonderAvailable and not WonderInWork > 0) and 1508 (IsCoastal or (WonderAvailable and not WonderInWork and 1509 not CoastalWonder > 0)) then 1510 begin 1511 iix := ChooseWonderToBuild(WonderAvailable and not 1512 WonderInWork, IsCoastal); 1513 City_StartImprovement(cix, iix); 1514 WonderInWork := WonderInWork or (1 shl iix); 1515 end 1516 else 1517 City_StopProduction(cix); 1518 end 1519 else if (Built[imPalace] > 0) and (RO.NatBuilt[imSpacePort] = 0) and 1520 City_Improvable(cix, imSpacePort) then 1521 City_StartImprovement(cix, imSpacePort) 1522 else if Built[imPalace] + Built[imCourt] + Built[imTownHall] = 0 then 1346 1523 begin 1347 mix:=RO.nModel-1; 1348 while RO.Model[mix].Kind<>mkSettler do dec(mix); 1349 City_StartUnitProduction(cix,mix) 1524 if City_Improvable(cix, imCourt) then 1525 City_StartImprovement(cix, imCourt) 1526 else 1527 City_StartImprovement(cix, imTownHall); 1350 1528 end 1351 end 1352 else if (RO.Government=gDespotism) and (nTownGuard<2) 1353 and (nTownGuard*2+3<Size) then 1354 begin 1355 if ProjectComplete then 1356 City_StartUnitProduction(cix,2) 1357 end 1358 else if (RO.Government=gFundamentalism) 1359 and (Size>=8) and (Built[imAqueduct]=0) 1360 and City_Improvable(cix,imAqueduct) and (RO.nUn>=RO.nCity*4) then 1361 begin 1362 if ProjectComplete then 1363 City_StartImprovement(cix,imAqueduct) 1364 end 1365 else if ProjectComplete then 1366 begin // low prio projects 1367 ImportantCity:=WillProduceColonyShip or (Built[imPalace]>0); 1368 for iix:=0 to 27 do if Built[iix]>0 then 1369 ImportantCity:=true; 1370 City_GetReportNew(cix, Report); 1371 if (Report.Corruption>=6) and (RO.nUn>=RO.nCity*4) 1372 and City_Improvable(cix,imCourt) then 1373 City_StartImprovement(cix,imCourt) 1374 else if (Report.Production>=WonderProductionThreshold) 1375 and (WonderAvailable and not WonderInWork>0) 1376 and (IsCoastal or (WonderAvailable and not WonderInWork and not CoastalWonder>0)) 1377 and (Random>=(1+WonderInclination)/(RO.nCity+WonderInclination)) then 1529 else if not HasSettler and (RO.nUn >= RO.nCity * 4) then 1378 1530 begin 1379 iix:=ChooseWonderToBuild(WonderAvailable and not WonderInWork,IsCoastal); 1380 City_StartImprovement(cix,iix); 1381 WonderInWork:=WonderInWork or (1 shl iix); 1531 if ProjectComplete and (City_CurrentUnitProject(cix) <> 0) then 1532 begin 1533 mix := RO.nModel - 1; 1534 while RO.Model[mix].Kind <> mkSettler do 1535 Dec(mix); 1536 City_StartUnitProduction(cix, mix); 1537 end; 1382 1538 end 1383 else if (ImportantCity or (Loc mod 9=0)) and (Built[imWalls]=0) 1384 and City_Improvable(cix,imWalls) then 1385 City_StartImprovement(cix,imWalls) 1386 else if IsPort and (ImportantCity or (Loc mod 7=0)) 1387 and (Built[imCoastalFort]=0) 1388 and City_Improvable(cix,imCoastalFort) then 1389 City_StartImprovement(cix,imCoastalFort) 1539 else if (RO.Government = gDespotism) and (nTownGuard < 2) and 1540 (nTownGuard * 2 + 3 < Size) then 1541 begin 1542 if ProjectComplete then 1543 City_StartUnitProduction(cix, 2); 1544 end 1545 else if (RO.Government = gFundamentalism) and 1546 (Size >= 8) and (Built[imAqueduct] = 0) and 1547 City_Improvable(cix, imAqueduct) and (RO.nUn >= RO.nCity * 4) then 1548 begin 1549 if ProjectComplete then 1550 City_StartImprovement(cix, imAqueduct); 1551 end 1552 else if ProjectComplete then 1553 begin // low prio projects 1554 ImportantCity := WillProduceColonyShip or (Built[imPalace] > 0); 1555 for iix := 0 to 27 do 1556 if Built[iix] > 0 then 1557 ImportantCity := True; 1558 City_GetReportNew(cix, Report); 1559 if (Report.Corruption >= 6) and (RO.nUn >= RO.nCity * 4) and 1560 City_Improvable(cix, imCourt) then 1561 City_StartImprovement(cix, imCourt) 1562 else if (Report.Production >= WonderProductionThreshold) and 1563 (WonderAvailable and not WonderInWork > 0) and 1564 (IsCoastal or (WonderAvailable and not WonderInWork and 1565 not CoastalWonder > 0)) and (Random >= 1566 (1 + WonderInclination) / (RO.nCity + WonderInclination)) then 1567 begin 1568 iix := ChooseWonderToBuild(WonderAvailable and not 1569 WonderInWork, IsCoastal); 1570 City_StartImprovement(cix, iix); 1571 WonderInWork := WonderInWork or (1 shl iix); 1572 end 1573 else if (ImportantCity or (Loc mod 9 = 0)) and 1574 (Built[imWalls] = 0) and City_Improvable(cix, imWalls) then 1575 City_StartImprovement(cix, imWalls) 1576 else if IsPort and (ImportantCity or (Loc mod 7 = 0)) and 1577 (Built[imCoastalFort] = 0) and City_Improvable(cix, imCoastalFort) then 1578 City_StartImprovement(cix, imCoastalFort) 1390 1579 {else if (ImportantCity or (Loc mod 11=0)) and (Built[imMissileBat]=0) 1391 1580 and City_Improvable(cix,imMissileBat) then 1392 1581 City_StartImprovement(cix,imMissileBat)} 1393 else if IsPort and (not SpezializeShipProduction or (f<0)1394 or (f>=maxCOD) or (ContinentPresence[f]=1 shl me))1395 and (Built[imDockyard]=0)1396 and City_Improvable(cix,imDockyard) then1397 City_StartImprovement(cix,imDockyard)1398 else if IsPort and (mixShip>=0) and1399 (not SpezializeShipProduction or (f<0) or (f>=maxCOD) or1400 (ContinentPresence[f]=1 shl me)) then1401 City_StartUnitProduction(cix,mixShip)1402 else if (Built[imBarracks]+Built[imMilAcademy]=0)1403 and City_Improvable(cix,imBarracks) then1404 City_StartImprovement(cix,imBarracks)1405 else if mixProduce>=0 then1406 City_StartUnitProduction(cix,mixProduce)1407 else if City_HasProject(cix) then1408 City_StopProduction(cix);1409 end 1410 end; 1411 end;1412 if (City_CurrentImprovementProject(cix)=imCourt)1413 and (Built[imTownHall]>0)1414 and (prod>=imp[imCourt].cost*BuildCostMod[G.Difficulty[me]] div 121415 -(imp[imTownHall].cost*BuildCostMod[G.Difficulty[me]] div 12)*2 div 3) then1416 City_RebuildImprovement(cix,imTownHall)1417 else if (RO.Government=gFundamentalism) and not WillProduceColonyShip then1418 for iix:=28 to nImp-1 do1419 if (Built[iix]>0)1420 and ((iix in [imTemple,imTheater,imCathedral,imColosseum,imLibrary,1421 imUniversity,imResLab,imHarbor,imSuperMarket])1422 or (iix in [imFactory,imMfgPlant,imPower,imHydro,imNuclear])1423 and (Built[imRecycling]=0)) then1424 begin1425 if City_RebuildImprovement(cix,iix)<rExecuted then1426 City_SellImprovement(cix,iix);1427 break1428 end1429 end1582 else if IsPort and (not SpezializeShipProduction or 1583 (f < 0) or (f >= maxCOD) or (ContinentPresence[f] = 1 shl me)) and 1584 (Built[imDockyard] = 0) and City_Improvable(cix, imDockyard) then 1585 City_StartImprovement(cix, imDockyard) 1586 else if IsPort and (mixShip >= 0) and 1587 (not SpezializeShipProduction or (f < 0) or 1588 (f >= maxCOD) or (ContinentPresence[f] = 1 shl me)) then 1589 City_StartUnitProduction(cix, mixShip) 1590 else if (Built[imBarracks] + Built[imMilAcademy] = 0) and 1591 City_Improvable(cix, imBarracks) then 1592 City_StartImprovement(cix, imBarracks) 1593 else if mixProduce >= 0 then 1594 City_StartUnitProduction(cix, mixProduce) 1595 else if City_HasProject(cix) then 1596 City_StopProduction(cix); 1597 end; 1598 end; 1599 end; 1600 if (City_CurrentImprovementProject(cix) = imCourt) and 1601 (Built[imTownHall] > 0) and (prod >= imp[imCourt].cost * 1602 BuildCostMod[G.Difficulty[me]] div 12 - 1603 (imp[imTownHall].cost * BuildCostMod[G.Difficulty[me]] div 12) * 1604 2 div 3) then 1605 City_RebuildImprovement(cix, imTownHall) 1606 else if (RO.Government = gFundamentalism) and not WillProduceColonyShip then 1607 for iix := 28 to nImp - 1 do 1608 if (Built[iix] > 0) and 1609 ((iix in [imTemple, imTheater, imCathedral, imColosseum, 1610 imLibrary, imUniversity, imResLab, imHarbor, imSuperMarket]) or 1611 (iix in [imFactory, imMfgPlant, imPower, imHydro, imNuclear]) and 1612 (Built[imRecycling] = 0)) then 1613 begin 1614 if City_RebuildImprovement(cix, iix) < rExecuted then 1615 City_SellImprovement(cix, iix); 1616 break; 1617 end; 1618 end; 1430 1619 end; 1431 1620 1432 1621 function TBarbarina.Barbarina_ChooseResearchAdvance: integer; 1433 1622 var 1434 nPreq,rmix,rmixChosen,i,MaxWeight,MaxDefense,ChosenPreq: integer;1435 NeedSeaUnits,ready: boolean;1436 ModelExists: set of 0..nModelCategory-1;1437 known: array[0..nAdv-1] of integer;1623 nPreq, rmix, rmixChosen, i, MaxWeight, MaxDefense, ChosenPreq: integer; 1624 NeedSeaUnits, ready: boolean; 1625 ModelExists: set of 0..nModelCategory - 1; 1626 known: array[0..nAdv - 1] of integer; 1438 1627 1439 1628 procedure ChoosePreq(ad: integer); 1440 1629 var 1441 i: integer;1442 PreqOk: boolean;1630 i: integer; 1631 PreqOk: boolean; 1443 1632 begin 1444 assert(RO.Tech[ad]<tsApplicable);1445 if known[ad]=0 then1633 assert(RO.Tech[ad] < tsApplicable); 1634 if known[ad] = 0 then 1446 1635 begin 1447 known[ad]:=1; 1448 PreqOk:=true; 1449 if not (ad in [adScience,adMassProduction]) and (RO.Tech[ad]<tsSeen) then 1450 for i:=0 to 1 do 1451 if (AdvPreq[ad,i]>=0) and (RO.Tech[AdvPreq[ad,i]]<tsApplicable) then 1452 begin 1453 PreqOk:=false; 1454 ChoosePreq(AdvPreq[ad,i]); 1455 end; 1456 if PreqOk then 1457 begin 1458 inc(nPreq); 1459 if random(nPreq)=0 then ChosenPreq:=ad 1460 end 1461 end 1636 known[ad] := 1; 1637 PreqOk := True; 1638 if not (ad in [adScience, adMassProduction]) and (RO.Tech[ad] < tsSeen) then 1639 for i := 0 to 1 do 1640 if (AdvPreq[ad, i] >= 0) and (RO.Tech[AdvPreq[ad, i]] < tsApplicable) then 1641 begin 1642 PreqOk := False; 1643 ChoosePreq(AdvPreq[ad, i]); 1644 end; 1645 if PreqOk then 1646 begin 1647 Inc(nPreq); 1648 if random(nPreq) = 0 then 1649 ChosenPreq := ad; 1650 end; 1651 end; 1462 1652 end; 1463 1653 1464 1654 begin 1465 // check military research 1466 rmixChosen:=-1; 1467 ModelExists:=[]; 1468 for rmix:=nResearchModel-1 downto 0 do with ResearchModel[rmix] do 1469 if not (Category in ModelExists) 1470 and ((adStop<0) or not IsResearched(adStop)) then 1655 // check military research 1656 rmixChosen := -1; 1657 ModelExists := []; 1658 for rmix := nResearchModel - 1 downto 0 do 1659 with ResearchModel[rmix] do 1660 if not (Category in ModelExists) and ((adStop < 0) or not 1661 IsResearched(adStop)) then 1662 begin 1663 MaxWeight := 0; 1664 case Domain of 1665 dGround: 1666 begin 1667 if IsResearched(adWarriorCode) then 1668 MaxWeight := 5; 1669 if IsResearched(adHorsebackRiding) then 1670 MaxWeight := 7; 1671 if IsResearched(adAutomobile) then 1672 MaxWeight := 10; 1673 end; 1674 dSea: 1675 begin 1676 if IsResearched(adMapMaking) then 1677 MaxWeight := 5; 1678 if IsResearched(adSeaFaring) then 1679 MaxWeight := 7; 1680 if IsResearched(adSteel) then 1681 MaxWeight := 9; 1682 end; 1683 dAir: 1684 begin 1685 if IsResearched(adFlight) then 1686 MaxWeight := 5; 1687 if IsResearched(adAdvancedFlight) then 1688 MaxWeight := 7; 1689 end; 1690 end; 1691 if Domain = dGround then 1692 MaxDefense := 2 1693 else 1694 MaxDefense := 3; 1695 if IsResearched(adSteel) then 1696 Inc(MaxDefense); 1697 ready := (MaxWeight >= Weight) and (MaxDefense >= Cap[mcDefense]); 1698 if ready then 1699 for i := 0 to nFeature - 1 do 1700 if (Cap[i] > 0) and (Feature[i].Preq <> preNone) and 1701 ((Feature[i].Preq < 0) or not IsResearched(Feature[i].Preq)) then 1702 ready := False; 1703 if ready then 1704 begin 1705 for i := 0 to nUpgrade - 1 do 1706 if (Upgrades and (1 shl i) <> 0) and not 1707 IsResearched(Upgrade[Domain, i].Preq) then 1708 ready := False; 1709 end; 1710 if ready then 1711 begin 1712 include(ModelExists, Category); 1713 if not IsModelAvailable(rmix) then 1714 rmixChosen := rmix; 1715 end; 1716 end; 1717 if rmixChosen >= 0 then 1718 with ResearchModel[rmixChosen] do 1471 1719 begin 1472 MaxWeight:=0; 1473 case Domain of 1474 dGround: 1475 begin 1476 if IsResearched(adWarriorCode) then MaxWeight:=5; 1477 if IsResearched(adHorsebackRiding) then MaxWeight:=7; 1478 if IsResearched(adAutomobile) then MaxWeight:=10; 1479 end; 1480 dSea: 1481 begin 1482 if IsResearched(adMapMaking) then MaxWeight:=5; 1483 if IsResearched(adSeaFaring) then MaxWeight:=7; 1484 if IsResearched(adSteel) then MaxWeight:=9; 1485 end; 1486 dAir: 1487 begin 1488 if IsResearched(adFlight) then MaxWeight:=5; 1489 if IsResearched(adAdvancedFlight) then MaxWeight:=7; 1490 end; 1491 end; 1492 if Domain=dGround then MaxDefense:=2 1493 else MaxDefense:=3; 1494 if IsResearched(adSteel) then inc(MaxDefense); 1495 ready:= (MaxWeight>=Weight) and (MaxDefense>=Cap[mcDefense]); 1496 if ready then 1497 for i:=0 to nFeature-1 do 1498 if (Cap[i]>0) and (Feature[i].Preq<>preNone) 1499 and ((Feature[i].Preq<0) or not IsResearched(Feature[i].Preq)) then 1500 ready:=false; 1501 if ready then 1502 begin 1503 for i:=0 to nUpgrade-1 do 1504 if (Upgrades and (1 shl i)<>0) and not IsResearched(Upgrade[Domain,i].Preq) then 1505 ready:=false; 1506 end; 1507 if ready then 1508 begin 1509 include(ModelExists,Category); 1510 if not IsModelAvailable(rmix) then 1511 rmixChosen:=rmix; 1512 end 1720 PrepareNewModel(Domain); 1721 for i := 0 to nFeature - 1 do 1722 if (i < 2) or (Cap[i] > 0) then 1723 SetNewModelFeature(i, Cap[i]); 1724 if RO.Wonder[woSun].EffectiveOwner = me then 1725 begin 1726 //if Cap[mcWeapons]>=2*Cap[mcArmor] then 1727 // SetNewModelFeature(mcFirst,1); 1728 if Cap[mcWeapons] >= Cap[mcArmor] then 1729 SetNewModelFeature(mcWill, 1); 1730 end; 1731 Result := adMilitary; 1732 exit; 1513 1733 end; 1514 if rmixChosen>=0 then with ResearchModel[rmixChosen] do 1734 1735 NeedSeaUnits := True; 1736 i := 0; 1737 while (i < nResearchOrder) and (not NeedSeaUnits and (ResearchOrder[i] < 0) or 1738 IsResearched(abs(ResearchOrder[i]))) do 1739 Inc(i); 1740 if i >= nResearchOrder then // list done, continue with future tech 1515 1741 begin 1516 PrepareNewModel(Domain); 1517 for i:=0 to nFeature-1 do if (i<2) or (Cap[i]>0) then 1518 SetNewModelFeature(i,Cap[i]); 1519 if RO.Wonder[woSun].EffectiveOwner=me then 1520 begin 1521 //if Cap[mcWeapons]>=2*Cap[mcArmor] then 1522 // SetNewModelFeature(mcFirst,1); 1523 if Cap[mcWeapons]>=Cap[mcArmor] then 1524 SetNewModelFeature(mcWill,1); 1525 end; 1526 result:=adMilitary; 1527 exit; 1742 if random(2) = 1 then 1743 Result := futArtificialIntelligence 1744 else 1745 Result := futMaterialTechnology; 1746 end 1747 else 1748 begin 1749 FillChar(known, SizeOf(known), 0); 1750 nPreq := 0; 1751 ChosenPreq := -1; 1752 ChoosePreq(abs(ResearchOrder[i])); 1753 assert(nPreq > 0); 1754 Result := ChosenPreq; 1528 1755 end; 1529 1530 NeedSeaUnits:=true;1531 i:=0;1532 while (i<nResearchOrder)1533 and (not NeedSeaUnits and (ResearchOrder[i]<0)1534 or IsResearched(abs(ResearchOrder[i]))) do1535 inc(i);1536 if i>=nResearchOrder then // list done, continue with future tech1537 begin1538 if random(2)=1 then1539 result:=futArtificialIntelligence1540 else result:=futMaterialTechnology;1541 end1542 else1543 begin1544 FillChar(known,SizeOf(known),0);1545 nPreq:=0;1546 ChosenPreq:=-1;1547 ChoosePreq(abs(ResearchOrder[i]));1548 assert(nPreq>0);1549 result:=ChosenPreq1550 end1551 1756 end; 1552 1757 1553 1758 function TBarbarina.Barbarina_WantCheckNegotiation(Nation: integer): boolean; 1554 1759 begin 1555 if (RO.Tech[adTheRepublic]<tsSeen) and (RO.Tech[adTheology]>=tsApplicable) 1556 and (RO.Tech[adGunPowder]>=tsApplicable) 1557 and (RO.EnemyReport[Nation].Tech[adTheRepublic]>=tsApplicable) then 1558 result:=true 1559 else result:=false; 1760 if (RO.Tech[adTheRepublic] < tsSeen) and (RO.Tech[adTheology] >= tsApplicable) and 1761 (RO.Tech[adGunPowder] >= tsApplicable) and 1762 (RO.EnemyReport[Nation].Tech[adTheRepublic] >= tsApplicable) then 1763 Result := True 1764 else 1765 Result := False; 1560 1766 end; 1561 1767 1562 1768 procedure TBarbarina.Barbarina_DoCheckNegotiation; 1563 1769 begin 1564 if RO.Tech[adTheRepublic]>=tsSeen then exit; // default reaction 1565 if MyLastAction=scContact then 1770 if RO.Tech[adTheRepublic] >= tsSeen then 1771 exit; // default reaction 1772 if MyLastAction = scContact then 1566 1773 begin 1567 MyAction:=scDipOffer; 1568 MyOffer.nDeliver:=1; 1569 MyOffer.nCost:=1; 1570 if (RO.Tech[adTheology]>=tsApplicable) 1571 and (RO.EnemyReport[Opponent].Tech[adTheology]<tsSeen) then 1572 MyOffer.Price[0]:=opTech+adTheology 1573 else MyOffer.Price[0]:=opChoose; 1574 MyOffer.Price[1]:=opTech+adTheRepublic; 1774 MyAction := scDipOffer; 1775 MyOffer.nDeliver := 1; 1776 MyOffer.nCost := 1; 1777 if (RO.Tech[adTheology] >= tsApplicable) and 1778 (RO.EnemyReport[Opponent].Tech[adTheology] < tsSeen) then 1779 MyOffer.Price[0] := opTech + adTheology 1780 else 1781 MyOffer.Price[0] := opChoose; 1782 MyOffer.Price[1] := opTech + adTheRepublic; 1575 1783 end 1576 else if OppoAction=scDipAccept then1577 else if OppoAction=scDipOffer then1784 else if OppoAction = scDipAccept then 1785 else if OppoAction = scDipOffer then 1578 1786 begin 1579 if (OppoOffer.nDeliver=1) and (OppoOffer.Price[0]=opTech+adTheRepublic)1580 and ((OppoOffer.nCost=0)1581 or (OppoOffer.nCost=1)1582 and (OppoOffer.Price[1] and opMask=opTech)1583 and (RO.Tech[OppoOffer.Price[1]-opTech]>=tsApplicable)) then1584 MyAction:=scDipAccept1585 else MyAction:=scDipBreak1787 if (OppoOffer.nDeliver = 1) and (OppoOffer.Price[0] = opTech + adTheRepublic) and 1788 ((OppoOffer.nCost = 0) or (OppoOffer.nCost = 1) and 1789 (OppoOffer.Price[1] and opMask = opTech) and 1790 (RO.Tech[OppoOffer.Price[1] - opTech] >= tsApplicable)) then 1791 MyAction := scDipAccept 1792 else 1793 MyAction := scDipBreak; 1586 1794 end 1587 else if OppoAction<>scDipBreak then1588 MyAction:=scDipBreak1795 else if OppoAction <> scDipBreak then 1796 MyAction := scDipBreak; 1589 1797 end; 1590 1798 1591 function TBarbarina.Barbarina_WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; 1799 function TBarbarina.Barbarina_WantNegotiation(Nation: integer; 1800 NegoTime: TNegoTime): boolean; 1592 1801 var 1593 uix,TestLoc,V8: integer;1594 Adjacent: TVicinity8Loc;1802 uix, TestLoc, V8: integer; 1803 Adjacent: TVicinity8Loc; 1595 1804 begin 1596 result:=false; 1597 case NegoTime of 1598 EnemyCalled: 1599 result:=false; 1600 EndOfTurn: 1601 result:=false; 1602 BeginOfTurn: 1603 if RO.Turn>=RO.LastCancelTreaty[Nation]+CancelTreatyTurns then 1604 begin 1605 if (RO.Turn and 3=(Nation+$F-me) and 3) and (RO.Treaty[Nation]>trPeace) then 1606 begin 1607 DebugMessage(1, 'End alliance/friendly contact with P'+char(48+Nation)); 1608 NegoCause:=CancelTreaty; 1609 result:=true 1805 Result := False; 1806 case NegoTime of 1807 EnemyCalled: 1808 Result := False; 1809 EndOfTurn: 1810 Result := False; 1811 BeginOfTurn: 1812 if RO.Turn >= RO.LastCancelTreaty[Nation] + CancelTreatyTurns then 1813 begin 1814 if (RO.Turn and 3 = (Nation + $F - me) and 3) and 1815 (RO.Treaty[Nation] > trPeace) then 1816 begin 1817 DebugMessage(1, 'End alliance/friendly contact with P' + char(48 + Nation)); 1818 NegoCause := CancelTreaty; 1819 Result := True; 1610 1820 end 1611 else if RO.Treaty[Nation]=trPeace then1821 else if RO.Treaty[Nation] = trPeace then 1612 1822 begin // declare war now? 1613 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 1614 if (Loc>=0) and (MyModel[mix].Attack>0) then 1615 begin 1616 V8_to_Loc(Loc,Adjacent); 1617 for V8:=0 to 7 do 1823 for uix := 0 to RO.nUn - 1 do 1824 with MyUnit[uix] do 1825 if (Loc >= 0) and (MyModel[mix].Attack > 0) then 1618 1826 begin 1619 TestLoc:=Adjacent[V8]; 1620 if (TestLoc>=0) and (RO.Territory[TestLoc]=Nation) 1621 and ((Map[TestLoc] and fTerrain>=fGrass) or (Master>=0) 1622 or (MyModel[mix].Domain<>dGround)) 1623 and ((Map[TestLoc] and fTerrain<fGrass) or (MyModel[mix].Domain<>dSea)) then 1827 V8_to_Loc(Loc, Adjacent); 1828 for V8 := 0 to 7 do 1624 1829 begin 1625 DebugMessage(1, 'Declare war on P'+char(48+Nation)); 1626 NegoCause:=CancelTreaty; 1627 result:=true; 1628 exit; 1629 end 1630 end 1631 end 1632 end 1633 end; 1634 end 1830 TestLoc := Adjacent[V8]; 1831 if (TestLoc >= 0) and (RO.Territory[TestLoc] = Nation) and 1832 ((Map[TestLoc] and fTerrain >= fGrass) or 1833 (Master >= 0) or (MyModel[mix].Domain <> dGround)) and 1834 ((Map[TestLoc] and fTerrain < fGrass) or 1835 (MyModel[mix].Domain <> dSea)) then 1836 begin 1837 DebugMessage(1, 'Declare war on P' + char(48 + Nation)); 1838 NegoCause := CancelTreaty; 1839 Result := True; 1840 exit; 1841 end; 1842 end; 1843 end; 1844 end; 1845 end; 1846 end; 1635 1847 end; 1636 1848 1637 1849 procedure TBarbarina.Barbarina_DoNegotiation; 1638 1850 begin 1639 if OppoAction=scDipStart then1851 if OppoAction = scDipStart then 1640 1852 begin 1641 if NegoCause=CancelTreaty then1642 MyAction:=scDipCancelTreaty1643 end 1853 if NegoCause = CancelTreaty then 1854 MyAction := scDipCancelTreaty; 1855 end; 1644 1856 end; 1645 1857 1646 1858 procedure TBarbarina.MakeColonyShipPlan; 1647 1859 var 1648 i,V21,V21C,CityLoc,Loc1,part,cix,BestValue,TestValue,FoodCount,ProdCount,1649 Prod Extra,Score,BestScore: integer;1650 Tile: cardinal;1651 ok,check: boolean;1652 Radius,RadiusC: TVicinity21Loc;1860 i, V21, V21C, CityLoc, Loc1, part, cix, BestValue, TestValue, FoodCount, 1861 ProdCount, ProdExtra, Score, BestScore: integer; 1862 Tile: cardinal; 1863 ok, check: boolean; 1864 Radius, RadiusC: TVicinity21Loc; 1653 1865 begin 1654 for part:=0 to nShipPart-1 do1866 for part := 0 to nShipPart - 1 do 1655 1867 begin 1656 ColonyShipPlan[part].cixProducing:=-1;1657 ColonyShipPlan[part].nLocResource:=0;1658 ColonyShipPlan[part].nLocFoundCity:=0;1868 ColonyShipPlan[part].cixProducing := -1; 1869 ColonyShipPlan[part].nLocResource := 0; 1870 ColonyShipPlan[part].nLocFoundCity := 0; 1659 1871 end; 1660 if RO.Tech[adMassProduction]>=tsApplicable then // able to recognize ressources yet1872 if RO.Tech[adMassProduction] >= tsApplicable then // able to recognize ressources yet 1661 1873 begin 1662 // check already existing cities 1663 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 1874 // check already existing cities 1875 for cix := 0 to RO.nCity - 1 do 1876 with MyCity[cix] do 1877 if Loc >= 0 then 1878 begin 1879 V21_to_Loc(Loc, Radius); 1880 for V21 := 1 to 26 do 1881 begin 1882 Loc1 := Radius[V21]; 1883 if Loc1 >= 0 then 1884 begin 1885 Tile := RO.Map[Loc1]; 1886 if Tile and fModern <> 0 then 1887 begin 1888 part := (Tile and fModern) shr 25 - 1; 1889 if RO.Ship[me].Parts[part] < ShipNeed[part] then 1890 // not enough of this kind already 1891 begin 1892 ok := True; 1893 if ColonyShipPlan[part].cixProducing >= 0 then 1894 begin // another city is already assigned to this ship part, choose one of the two 1895 TestValue := (ID and $FFF) shl 4 + ((ID shr 12) + 15 - me) and $F; 1896 BestValue := 1897 (MyCity[ColonyShipPlan[part].cixProducing].ID and $FFF) shl 1898 4 + ((MyCity[ColonyShipPlan[part].cixProducing].ID shr 12) + 1899 15 - me) and $F; 1900 if TestValue <= BestValue then 1901 ok := False; 1902 end; 1903 if ok then 1904 ColonyShipPlan[part].cixProducing := cix; 1905 end; 1906 end; 1907 end; 1908 end; 1909 end; 1910 1911 // for parts without existing city, look for location of city to found 1912 check := False; 1913 for part := 0 to nShipPart - 1 do 1914 if (RO.Ship[me].Parts[part] < ShipNeed[part]) // not enough of this kind already 1915 and (ColonyShipPlan[part].cixProducing < 0) then // no city to produce 1916 check := True; 1917 if check then 1664 1918 begin 1665 V21_to_Loc(Loc, Radius); 1666 for V21:=1 to 26 do 1667 begin 1668 Loc1:=Radius[V21]; 1669 if Loc1>=0 then 1670 begin 1671 Tile:=RO.Map[Loc1]; 1672 if Tile and fModern<>0 then 1673 begin 1674 part:=(Tile and fModern) shr 25 -1; 1675 if RO.Ship[me].Parts[part]<ShipNeed[part] then // not enough of this kind already 1676 begin 1677 ok:=true; 1678 if ColonyShipPlan[part].cixProducing>=0 then 1679 begin // another city is already assigned to this ship part, choose one of the two 1680 TestValue:=(ID and $FFF) shl 4 1681 + ((ID shr 12)+15-me) and $F; 1682 BestValue:=(MyCity[ColonyShipPlan[part].cixProducing].ID and $FFF) shl 4 1683 + ((MyCity[ColonyShipPlan[part].cixProducing].ID shr 12)+15-me) and $F; 1684 if TestValue<=BestValue then 1685 ok:=false; 1919 for Loc1 := 0 to MapSize - 1 do 1920 begin 1921 Tile := RO.Map[Loc1]; 1922 if Tile and fModern <> 0 then 1923 begin 1924 part := (Tile and fModern) shr 25 - 1; 1925 if ColonyShipPlan[part].nLocResource < maxModern then 1926 begin 1927 ColonyShipPlan[part].LocResource[ColonyShipPlan[part].nLocResource] := Loc1; 1928 Inc(ColonyShipPlan[part].nLocResource); 1929 end; 1930 end; 1931 end; 1932 for part := 0 to nShipPart - 1 do 1933 if (RO.Ship[me].Parts[part] < ShipNeed[part]) // not enough of this kind already 1934 and (ColonyShipPlan[part].cixProducing < 0) // no city to produce 1935 and (ColonyShipPlan[part].nLocResource > 0) then // resource is known 1936 begin 1937 for i := 0 to ColonyShipPlan[part].nLocResource - 1 do 1938 begin 1939 BestScore := 0; 1940 V21_to_Loc(ColonyShipPlan[part].LocResource[i], Radius); 1941 for V21 := 1 to 26 do 1942 begin // check all potential cities in range 1943 CityLoc := Radius[V21]; 1944 if CityLoc >= 0 then 1945 begin 1946 Tile := RO.Map[CityLoc]; 1947 if (Tile and fTerrain <> fUNKNOWN) and 1948 ((Tile and fTerrain = fForest) or 1949 (Tile and fTerrain = fSwamp) or 1950 (Terrain[Tile and fTerrain].IrrEff > 0)) then 1951 begin 1952 FoodCount := 0; 1953 ProdCount := 0; 1954 ProdExtra := 0; 1955 V21_to_Loc(CityLoc, RadiusC); 1956 for V21C := 1 to 26 do 1957 begin 1958 Loc1 := RadiusC[V21C]; 1959 if Loc1 >= 0 then 1960 begin 1961 case RO.Map[Loc1] and (fTerrain or fSpecial) of 1962 fGrass, fGrass + fSpecial1, fSwamp: Inc(FoodCount); 1963 fHills, fHills + fSpecial1: Inc(ProdCount); 1964 fShore + fSpecial1, fDesert + fSpecial1, fPrairie + fSpecial1, 1965 fForest + fSpecial1: 1966 Inc(FoodCount, 2); 1967 fSwamp + fSpecial1, fShore + fSpecial2, fDesert + fSpecial2, 1968 fPrairie + fSpecial2, fTundra + fSpecial2, fArctic + fSpecial1, 1969 fHills + fSpecial2, fMountains + fSpecial1: 1970 begin 1971 Inc(ProdCount); 1972 Inc(ProdExtra); 1973 end; 1974 end; 1975 end; 1976 end; 1977 if FoodCount = 0 then 1978 Score := 0 1979 else 1980 begin 1981 if ProdCount > 7 then 1982 ProdCount := 7; 1983 if FoodCount < 5 then 1984 Dec(ProdCount, 5 - FoodCount); 1985 Score := ProdCount * 4 + ProdExtra * 8 + FoodCount; 1986 Score := Score shl 8 + ((CityLoc xor me) * 4567) mod 251; 1987 // some unexactness, random but always the same for this tile 1988 end; 1989 if Score > BestScore then 1990 begin 1991 BestScore := Score; 1992 ColonyShipPlan[part].LocFoundCity[ 1993 ColonyShipPlan[part].nLocFoundCity] := 1994 CityLoc; 1995 end; 1996 end; 1686 1997 end; 1687 if ok then 1688 ColonyShipPlan[part].cixProducing:=cix; 1689 end 1690 end 1691 end 1692 end 1998 end; 1999 if BestScore > 0 then 2000 Inc(ColonyShipPlan[part].nLocFoundCity); 2001 end; 2002 end; 1693 2003 end; 1694 1695 // for parts without existing city, look for location of city to found 1696 check:=false; 1697 for part:=0 to nShipPart-1 do 1698 if (RO.Ship[me].Parts[part]<ShipNeed[part]) // not enough of this kind already 1699 and (ColonyShipPlan[part].cixProducing<0) then // no city to produce 1700 check:=true; 1701 if check then 1702 begin 1703 for Loc1:=0 to MapSize-1 do 1704 begin 1705 Tile:=RO.Map[Loc1]; 1706 if Tile and fModern<>0 then 1707 begin 1708 part:=(Tile and fModern) shr 25 -1; 1709 if ColonyShipPlan[part].nLocResource<maxModern then 1710 begin 1711 ColonyShipPlan[part].LocResource[ColonyShipPlan[part].nLocResource]:=Loc1; 1712 inc(ColonyShipPlan[part].nLocResource); 1713 end; 1714 end 1715 end; 1716 for part:=0 to nShipPart-1 do 1717 if (RO.Ship[me].Parts[part]<ShipNeed[part]) // not enough of this kind already 1718 and (ColonyShipPlan[part].cixProducing<0) // no city to produce 1719 and (ColonyShipPlan[part].nLocResource>0) then // resource is known 1720 begin 1721 for i:=0 to ColonyShipPlan[part].nLocResource-1 do 1722 begin 1723 BestScore:=0; 1724 V21_to_Loc(ColonyShipPlan[part].LocResource[i],Radius); 1725 for V21:=1 to 26 do 1726 begin // check all potential cities in range 1727 CityLoc:=Radius[V21]; 1728 if CityLoc>=0 then 1729 begin 1730 Tile:=RO.Map[CityLoc]; 1731 if (Tile and fTerrain<>fUNKNOWN) 1732 and ((Tile and fTerrain=fForest) 1733 or (Tile and fTerrain=fSwamp) 1734 or (Terrain[Tile and fTerrain].IrrEff>0)) then 1735 begin 1736 FoodCount:=0; 1737 ProdCount:=0; 1738 ProdExtra:=0; 1739 V21_to_Loc(CityLoc,RadiusC); 1740 for V21C:=1 to 26 do 1741 begin 1742 Loc1:=RadiusC[V21C]; 1743 if Loc1>=0 then 1744 begin 1745 case RO.Map[Loc1] and (fTerrain or fSpecial) of 1746 fGrass, fGrass+fSpecial1, fSwamp: inc(FoodCount); 1747 fHills, fHills+fSpecial1: inc(ProdCount); 1748 fShore+fSpecial1, fDesert+fSpecial1, fPrairie+fSpecial1, 1749 fForest+fSpecial1: 1750 inc(FoodCount,2); 1751 fSwamp+fSpecial1, fShore+fSpecial2, fDesert+fSpecial2, 1752 fPrairie+fSpecial2, fTundra+fSpecial2, fArctic+fSpecial1, 1753 fHills+fSpecial2, fMountains+fSpecial1: 1754 begin 1755 inc(ProdCount); 1756 inc(ProdExtra); 1757 end; 1758 end 1759 end 1760 end; 1761 if FoodCount=0 then 1762 Score:=0 1763 else 1764 begin 1765 if ProdCount>7 then 1766 ProdCount:=7; 1767 if FoodCount<5 then 1768 dec(ProdCount, 5-FoodCount); 1769 Score:=ProdCount*4+ProdExtra*8+FoodCount; 1770 Score:=Score shl 8 + ((CityLoc xor me)*4567) mod 251; 1771 // some unexactness, random but always the same for this tile 1772 end; 1773 if Score>BestScore then 1774 begin 1775 BestScore:=Score; 1776 ColonyShipPlan[part].LocFoundCity[ColonyShipPlan[part].nLocFoundCity]:=CityLoc; 1777 end 1778 end 1779 end 1780 end; 1781 if BestScore>0 then 1782 inc(ColonyShipPlan[part].nLocFoundCity); 1783 end; 1784 end 1785 end 1786 end 2004 end; 1787 2005 end; 1788 2006 1789 2007 end. 1790 -
branches/highdpi/AI/StdAI/CustomAI.pas
r210 r303 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; 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; 115 end; 116 117 118 var 119 Server: TServerCall; 120 G: TNewGameData; 121 RWDataSize, MapSize: integer; 122 decompose24: cardinal; 123 nodata: pointer; 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; 74 var RemainingMovement: integer): boolean; 75 function Unit_AttackForecast(uix, ToLoc, AttackMovement: integer; 76 var RemainingHealth: integer): boolean; 77 function Unit_DefenseForecast(euix, ToLoc: integer; 78 var RemainingHealth: integer): boolean; 79 function Unit_Disband(uix: integer): integer; 80 function Unit_StartJob(uix, NewJob: integer): integer; 81 function Unit_SetHomeHere(uix: integer): integer; 82 function Unit_Load(uix: integer): integer; 83 function Unit_Unload(uix: integer): integer; 84 function Unit_SelectTransport(uix: integer): integer; 85 function Unit_AddToCity(uix: integer): integer; 86 87 // city functions 88 procedure City_FindMyCity(Loc: integer; var cix: integer); 89 procedure City_FindEnemyCity(Loc: integer; var ecix: integer); 90 function City_HasProject(cix: integer): boolean; 91 function City_CurrentImprovementProject(cix: integer): integer; 92 function City_CurrentUnitProject(cix: integer): integer; 93 function City_GetTileInfo(cix, TileLoc: integer; var TileInfo: TTileInfo): integer; 94 function City_GetReport(cix: integer; var Report: TCityReport): integer; 95 function City_GetHypoReport(cix, HypoTiles, HypoTax, HypoLux: integer; 96 var Report: TCityReport): integer; 97 function City_GetReportNew(cix: integer; var Report: TCityReportNew): integer; 98 function City_GetHypoReportNew(cix, HypoTiles, HypoTaxRate, HypoLuxuryRate: integer; 99 var Report: TCityReportNew): integer; 100 function City_GetAreaInfo(cix: integer; var AreaInfo: TCityAreaInfo): integer; 101 function City_StartUnitProduction(cix, mix: integer): integer; 102 function City_StartEmigration(cix, mix: integer; 103 AllowDisbandCity, AsConscripts: boolean): integer; 104 function City_StartImprovement(cix, iix: integer): integer; 105 function City_Improvable(cix, iix: integer): boolean; 106 function City_StopProduction(cix: integer): integer; 107 function City_BuyProject(cix: integer): integer; 108 function City_SellImprovement(cix, iix: integer): integer; 109 function City_RebuildImprovement(cix, iix: integer): integer; 110 function City_SetTiles(cix, NewTiles: integer): integer; 111 procedure City_OptimizeTiles(cix: integer; ResourceWeights: cardinal = rwMaxGrowth); 112 113 // negotiation 114 function Nego_CheckMyAction: integer; 115 116 private 117 HaveTurned: boolean; 118 UnwantedNego: set of 0..nPl - 1; 119 Contacted: set of 0..nPl - 1; 120 procedure StealAdvance; 121 end; 122 123 124 var 125 Server: TServerCall; 126 G: TNewGameData; 127 RWDataSize, MapSize: integer; 128 decompose24: cardinal; 129 nodata: pointer; 124 130 125 131 const 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 132 CityOwnTile = 13; // = ab_to_V21(0,0) 133 134 // additional return codes 135 rLocationReached = $00010000; 136 // Unit_Move: move was not interrupted, location reached 137 rMoreTurns = $00020000; 138 // Unit_Move: move was not interrupted, location not reached yet 131 139 132 140 type 133 TVicinity8Loc=array[0..7] of integer;134 TVicinity21Loc=array[0..27] of integer;141 TVicinity8Loc = array[0..7] of integer; 142 TVicinity21Loc = array[0..27] of integer; 135 143 136 144 137 145 procedure Init(NewGameData: TNewGameData); 138 146 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);147 procedure ab_to_Loc(Loc0, a, b: integer; var Loc: integer); 148 procedure Loc_to_ab(Loc0, Loc: integer; var a, b: integer); 149 procedure ab_to_V8(a, b: integer; var V8: integer); 150 procedure V8_to_ab(V8: integer; var a, b: integer); 151 procedure ab_to_V21(a, b: integer; var V21: integer); 152 procedure V21_to_ab(V21: integer; var a, b: integer); 145 153 procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc); 146 154 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); 147 function Distance(Loc0, Loc1: integer): integer;155 function Distance(Loc0, Loc1: integer): integer; 148 156 149 157 … … 151 159 152 160 const 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);161 ab_v8: array[-4..4] of integer = (5, 6, 7, 4, -1, 0, 3, 2, 1); 162 v8_a: array[0..7] of integer = (1, 1, 0, -1, -1, -1, 0, 1); 163 v8_b: array[0..7] of integer = (0, 1, 1, 1, 0, -1, -1, -1); 164 165 166 procedure ab_to_Loc(Loc0, a, b: integer; var Loc: integer); 159 167 {relative location from Loc0} 160 168 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); 170 {$IFDEF FPC} // freepascal 171 var 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; 179 end; 180 {$ELSE} // delphi 169 y0: integer; 170 begin 171 assert((Loc0 >= 0) and (Loc0 < MapSize) and (a - b + G.lx >= 0)); 172 y0 := cardinal(Loc0) * decompose24 shr 24; 173 Loc := (Loc0 + (a - b + y0 and 1 + G.lx + G.lx) shr 1) mod G.lx + G.lx * (y0 + a + b); 174 if Loc >= MapSize then 175 Loc := -$1000; 176 end; 177 178 procedure Loc_to_ab(Loc0, Loc: integer; var a, b: integer); 179 {$IFDEF FPC}// freepascal 180 var 181 dx, dy: integer; 182 begin 183 dx := ((Loc mod G.lx * 2 + Loc div G.lx and 1) - (Loc0 mod G.lx * 2 + Loc0 div 184 G.lx and 1) + 3 * G.lx) mod (2 * G.lx) - G.lx; 185 dy := Loc div G.lx - Loc0 div G.lx; 186 a := (dx + dy) div 2; 187 b := (dy - dx) div 2; 188 end; 189 190 {$ELSE}// delphi 181 191 register; 182 192 asm … … 234 244 {$ENDIF} 235 245 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; 246 procedure ab_to_V8(a, b: integer; var V8: integer); 247 begin 248 assert((abs(a) <= 1) and (abs(b) <= 1) and ((a <> 0) or (b <> 0))); 249 V8 := ab_v8[2 * b + b + a]; 250 end; 251 252 procedure V8_to_ab(V8: integer; var a, b: integer); 253 begin 254 a := v8_a[V8]; 255 b := V8_b[V8]; 256 end; 257 258 procedure ab_to_V21(a, b: integer; var V21: integer); 259 begin 260 V21 := (a + b + 3) shl 2 + (a - b + 3) shr 1; 261 end; 262 263 procedure V21_to_ab(V21: integer; var a, b: integer); 264 var 265 dx, dy: integer; 266 begin 267 dy := V21 shr 2 - 3; 268 dx := V21 and 3 shl 1 - 3 + (dy + 3) and 1; 269 a := (dx + dy) div 2; 270 b := (dy - dx) div 2; 260 271 end; 261 272 262 273 procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc); 263 274 var 264 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 then275 x0, y0, lx: integer; 276 begin 277 lx := G.lx; 278 y0 := cardinal(Loc0) * decompose24 shr 24; 279 x0 := Loc0 - y0 * lx; // Loc0 mod lx; 280 VicinityLoc[1] := Loc0 + lx * 2; 281 VicinityLoc[3] := Loc0 - 1; 282 VicinityLoc[5] := Loc0 - lx * 2; 283 VicinityLoc[7] := Loc0 + 1; 284 Inc(Loc0, y0 and 1); 285 VicinityLoc[0] := Loc0 + lx; 286 VicinityLoc[2] := Loc0 + lx - 1; 287 VicinityLoc[4] := Loc0 - lx - 1; 288 VicinityLoc[6] := Loc0 - lx; 289 290 // world is round! 291 if x0 < lx - 1 then 281 292 begin 282 if x0=0 then293 if x0 = 0 then 283 294 begin 284 inc(VicinityLoc[3],lx);285 if y0 and 1=0 then295 Inc(VicinityLoc[3], lx); 296 if y0 and 1 = 0 then 286 297 begin 287 inc(VicinityLoc[2],lx); 288 inc(VicinityLoc[4],lx); 298 Inc(VicinityLoc[2], lx); 299 Inc(VicinityLoc[4], lx); 300 end; 301 end; 302 end 303 else 304 begin 305 Dec(VicinityLoc[7], lx); 306 if y0 and 1 = 1 then 307 begin 308 Dec(VicinityLoc[0], lx); 309 Dec(VicinityLoc[6], lx); 310 end; 311 end; 312 313 // check south pole 314 case G.ly - y0 of 315 1: 316 begin 317 VicinityLoc[0] := -$1000; 318 VicinityLoc[1] := -$1000; 319 VicinityLoc[2] := -$1000; 320 end; 321 2: VicinityLoc[1] := -$1000; 322 end; 323 end; 324 325 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); 326 var 327 dx, dy, bit, y0, xComp, yComp, xComp0, xCompSwitch: integer; 328 dst: ^integer; 329 begin 330 y0 := cardinal(Loc0) * decompose24 shr 24; 331 xComp0 := Loc0 - y0 * G.lx - 1; // Loc0 mod G.lx -1 332 xCompSwitch := xComp0 - 1 + y0 and 1; 333 if xComp0 < 0 then 334 Inc(xComp0, G.lx); 335 if xCompSwitch < 0 then 336 Inc(xCompSwitch, G.lx); 337 xCompSwitch := xCompSwitch xor xComp0; 338 yComp := G.lx * (y0 - 3); 339 dst := @VicinityLoc; 340 bit := 1; 341 for dy := 0 to 6 do 342 if yComp < MapSize then 343 begin 344 xComp0 := xComp0 xor xCompSwitch; 345 xComp := xComp0; 346 for dx := 0 to 3 do 347 begin 348 if bit and $67F7F76 <> 0 then 349 dst^ := xComp + yComp 350 else 351 dst^ := -1; 352 Inc(xComp); 353 if xComp >= G.lx then 354 Dec(xComp, G.lx); 355 Inc(dst); 356 bit := bit shl 1; 357 end; 358 Inc(yComp, G.lx); 359 end 360 else 361 begin 362 for dx := 0 to 3 do 363 begin 364 dst^ := -$1000; 365 Inc(dst); 366 end; 367 end; 368 end; 369 370 function Distance(Loc0, Loc1: integer): integer; 371 var 372 a, b, dx, dy: integer; 373 begin 374 Loc_to_ab(Loc0, Loc1, a, b); 375 dx := abs(a - b); 376 dy := abs(a + b); 377 Result := dx + dy + abs(dx - dy) shr 1; 378 end; 379 380 381 procedure Init(NewGameData: TNewGameData); 382 {$IFDEF DEBUG}var 383 Loc: integer; 384 {$ENDIF} 385 begin 386 G := NewGameData; 387 MapSize := G.lx * G.ly; 388 decompose24 := (1 shl 24 - 1) div G.lx + 1; 389 {$IFDEF DEBUG} 390 for Loc := 0 to MapSize - 1 do 391 assert(cardinal(Loc) * decompose24 shr 24 = cardinal(Loc div G.lx)); 392 {$ENDIF} 393 end; 394 395 396 constructor TCustomAI.Create(Nation: integer); 397 begin 398 inherited Create; 399 me := Nation; 400 RO := pointer(G.RO[Nation]); 401 Map := pointer(RO.Map); 402 MyUnit := pointer(RO.Un); 403 MyCity := pointer(RO.City); 404 MyModel := pointer(RO.Model); 405 Opponent := -1; 406 end; 407 408 destructor TCustomAI.Destroy; 409 begin 410 Server(sSetDebugMap, me, 0, nodata^); 411 end; 412 413 414 procedure TCustomAI.Process(Command: integer; var Data); 415 var 416 Nation, NewResearch, NewGov, Count, ad, cix, iix: integer; 417 NegoTime: TNegoTime; 418 begin 419 case Command of 420 cTurn, cContinue: 421 begin 422 if RO.Alive and (1 shl me) = 0 then 423 begin // I'm dead, huhu 424 Server(sTurn, me, 0, nodata^); 425 exit; 426 end; 427 if Command = cTurn then 428 begin 429 fillchar(cixStateImp, sizeof(cixStateImp), $FF); 430 for cix := 0 to RO.nCity - 1 do 431 if MyCity[cix].Loc >= 0 then 432 for iix := imPalace to imSpacePort do 433 if MyCity[cix].Built[iix] > 0 then 434 cixStateImp[iix] := cix; 435 if RO.Happened and phChangeGov <> 0 then 436 begin 437 NewGov := ChooseGovernment; 438 if NewGov > gAnarchy then 439 Server(sSetGovernment, me, NewGov, nodata^); 440 end; 441 HaveTurned := False; 442 Contacted := []; 443 end; 444 if (Command = cContinue) and (MyAction = scContact) then 445 begin 446 if OnNegoRejected_CancelTreaty then 447 if RO.Treaty[Opponent] >= trPeace then 448 if Server(sCancelTreaty, me, 0, nodata^) < rExecuted then 449 assert(False); 289 450 end 290 end 291 end 292 else 293 begin 294 dec(VicinityLoc[7],lx); 295 if y0 and 1=1 then 451 else 452 UnwantedNego := []; 453 Opponent := -1; 454 repeat 455 if HaveTurned then 456 NegoTime := EndOfTurn 457 else 458 NegoTime := BeginOfTurn; 459 if RO.Government <> gAnarchy then 460 for Nation := 0 to nPl - 1 do 461 if (Nation <> me) and (1 shl Nation and RO.Alive <> 0) and 462 (RO.Treaty[Nation] >= trNone) and not (Nation in Contacted) and not 463 (Nation in UnwantedNego) and 464 (Server(scContact - sExecute + Nation shl 4, me, 0, nodata^) >= rExecuted) then 465 if WantNegotiation(Nation, NegoTime) then 466 begin 467 if Server(scContact + Nation shl 4, me, 0, nodata^) >= rExecuted then 468 begin 469 include(Contacted, Nation); 470 Opponent := Nation; 471 MyAction := scContact; 472 exit; 473 end; 474 end 475 else 476 include(UnwantedNego, Nation); 477 if NegoTime = BeginOfTurn then 478 begin 479 DoTurn; 480 HaveTurned := True; 481 Contacted := []; 482 UnwantedNego := []; 483 end 484 else 485 break; 486 until False; 487 if RO.Happened and phTech <> 0 then 488 begin 489 NewResearch := ChooseResearchAdvance; 490 if NewResearch < 0 then 491 begin // choose random research 492 Count := 0; 493 for ad := 0 to nAdv - 1 do 494 if AdvanceResearchable(ad) then 495 begin 496 Inc(Count); 497 if random(Count) = 0 then 498 NewResearch := ad; 499 end; 500 end; 501 Server(sSetResearch, me, NewResearch, nodata^); 502 end; 503 if Server(sTurn, me, 0, nodata^) < rExecuted then 504 assert(False); 505 end; 506 scContact: 507 if WantNegotiation(integer(Data), EnemyCalled) then 508 begin 509 if Server(scDipStart, me, 0, nodata^) < rExecuted then 510 assert(False); 511 Opponent := integer(Data); 512 MyAction := scDipStart; 513 end 514 else 515 begin 516 if Server(scReject, me, 0, nodata^) < rExecuted then 517 assert(False); 518 end; 519 scDipStart, scDipNotice, scDipAccept, scDipCancelTreaty, scDipOffer, scDipBreak: 296 520 begin 297 dec(VicinityLoc[0],lx); 298 dec(VicinityLoc[6],lx); 299 end 300 end; 301 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; 521 OppoAction := Command; 522 if Command = scDipOffer then 523 OppoOffer := TOffer(Data); 524 if Command = scDipStart then 525 MyLastAction := scContact 526 else 527 begin 528 MyLastAction := MyAction; 529 MyLastOffer := MyOffer; 530 end; 531 if (OppoAction = scDipCancelTreaty) or (OppoAction = scDipBreak) then 532 MyAction := scDipNotice 533 else 534 begin 535 MyAction := scDipOffer; 536 MyOffer.nDeliver := 0; 537 MyOffer.nCost := 0; 538 end; 539 DoNegotiation; 540 assert((MyAction = scDipNotice) or (MyAction = scDipAccept) or 541 (MyAction = scDipCancelTreaty) or (MyAction = scDipOffer) or (MyAction = scDipBreak)); 542 if MyAction = scDipOffer then 543 Server(MyAction, me, 0, MyOffer) 544 else 545 Server(MyAction, me, 0, nodata^); 309 546 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 334 begin 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; 341 end; 342 inc(yComp,G.lx); 343 end 344 else 345 begin 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 404 begin 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:=[]; 418 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 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: 485 begin 486 OppoAction:=Command; 487 if Command=scDipOffer then OppoOffer:=TOffer(Data); 488 if Command=scDipStart then 489 MyLastAction:=scContact 490 else 491 begin 492 MyLastAction:=MyAction; 493 MyLastOffer:=MyOffer; 494 end; 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; 547 cShowEndContact: 548 Opponent := -1; 507 549 end; 508 550 end; … … 525 567 end; 526 568 527 procedure TCustomAI.OnBeforeEnemyAttack(UnitInfo: TUnitInfo; ToLoc, EndHealth,528 EndHealthDef: integer);569 procedure TCustomAI.OnBeforeEnemyAttack(UnitInfo: TUnitInfo; 570 ToLoc, EndHealth, EndHealthDef: integer); 529 571 begin 530 572 end; … … 544 586 function TCustomAI.ChooseResearchAdvance: integer; 545 587 begin 546 result:=-1 588 Result := -1; 547 589 end; 548 590 549 591 function TCustomAI.ChooseStealAdvance: integer; 550 592 begin 551 result:=-1 593 Result := -1; 552 594 end; 553 595 554 596 function TCustomAI.ChooseGovernment: integer; 555 597 begin 556 result:=gDespotism 598 Result := gDespotism; 557 599 end; 558 600 559 601 function TCustomAI.WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean; 560 602 begin 561 result:=false;603 Result := False; 562 604 end; 563 605 564 606 function TCustomAI.OnNegoRejected_CancelTreaty: boolean; 565 607 begin 566 result:=false; 567 end; 608 Result := False; 609 end; 610 568 611 {$HINTS ON} 569 612 570 613 procedure TCustomAI.StealAdvance; 571 614 var 572 Steal, ad, count: integer;573 begin 574 Steal:=ChooseStealAdvance;575 if Steal<0 then615 Steal, ad, Count: integer; 616 begin 617 Steal := ChooseStealAdvance; 618 if Steal < 0 then 576 619 begin // choose random advance 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 580 end; 581 if Steal>=0 then Server(sStealTech,me,Steal,nodata^); 582 RO.Happened:=RO.Happened and not phStealTech 620 Count := 0; 621 for ad := 0 to nAdv - 1 do 622 if AdvanceStealable(ad) then 623 begin 624 Inc(Count); 625 if random(Count) = 0 then 626 Steal := ad; 627 end; 628 end; 629 if Steal >= 0 then 630 Server(sStealTech, me, Steal, nodata^); 631 RO.Happened := RO.Happened and not phStealTech; 583 632 end; 584 633 585 634 function TCustomAI.IsResearched(Advance: integer): boolean; 586 635 begin 587 result:= (Advance=preNone) 588 or (Advance<>preNA) and (RO.Tech[Advance]>=tsApplicable) 636 Result := (Advance = preNone) or (Advance <> preNA) and (RO.Tech[Advance] >= tsApplicable); 589 637 end; 590 638 591 639 function TCustomAI.ResearchCost: integer; 592 640 begin 593 Server(sGetTechCost,me,0,result) 641 Server(sGetTechCost, me, 0, Result); 594 642 end; 595 643 596 644 function TCustomAI.ChangeAttitude(Nation, Attitude: integer): integer; 597 645 begin 598 result:=Server(sSetAttitude+Nation shl 4,me,Attitude,nodata^) 646 Result := Server(sSetAttitude + Nation shl 4, me, Attitude, nodata^); 599 647 end; 600 648 601 649 function TCustomAI.Revolution: integer; 602 650 begin 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^) 651 Result := Server(sRevolution, me, 0, nodata^); 652 end; 653 654 function TCustomAI.ChangeRates(Tax, Lux: integer): integer; 655 begin 656 Result := Server(sSetRates, me, Tax div 10 and $f + Lux div 10 and $f shl 4, nodata^); 609 657 end; 610 658 611 659 function TCustomAI.PrepareNewModel(Domain: integer): integer; 612 660 begin 613 result:=Server(sCreateDevModel,me,Domain,nodata^);661 Result := Server(sCreateDevModel, me, Domain, nodata^); 614 662 end; 615 663 616 664 function TCustomAI.SetNewModelFeature(F, Count: integer): integer; 617 665 begin 618 result:=Server(sSetDevModelCap+Count shl 4,me,F,nodata^) 666 Result := Server(sSetDevModelCap + Count shl 4, me, F, nodata^); 619 667 end; 620 668 621 669 function TCustomAI.AdvanceResearchable(Advance: integer): boolean; 622 670 begin 623 result:= Server(sSetResearch-sExecute,me,Advance,nodata^)>=rExecuted;671 Result := Server(sSetResearch - sExecute, me, Advance, nodata^) >= rExecuted; 624 672 end; 625 673 626 674 function TCustomAI.AdvanceStealable(Advance: integer): boolean; 627 675 begin 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; 676 Result := Server(sStealTech - sExecute, me, Advance, nodata^) >= rExecuted; 677 end; 678 679 function TCustomAI.GetJobProgress(Loc: integer; 680 var JobProgress: TJobProgressData): boolean; 681 begin 682 Result := Server(sGetJobProgress, me, Loc, JobProgress) >= rExecuted; 634 683 end; 635 684 636 685 function TCustomAI.DebugMessage(Level: integer; Text: string): boolean; 637 686 begin 638 Text:=copy('P'+char(48+me)+' '+Text,1,254);639 Server(sMessage,me,Level,pchar(Text)^);640 641 result:=true;687 Text := copy('P' + char(48 + me) + ' ' + Text, 1, 254); 688 Server(sMessage, me, Level, PChar(Text)^); 689 690 Result := True; 642 691 // always returns true so that it can be used like 643 692 // "assert(DebugMessage(...));" -> not compiled in release build … … 646 695 function TCustomAI.SetDebugMap(var DebugMap): boolean; 647 696 begin 648 Server(sSetDebugMap, me, 0, DebugMap);649 650 result:=true;697 Server(sSetDebugMap, me, 0, DebugMap); 698 699 Result := True; 651 700 // always returns true so that it can be used like 652 701 // "assert(SetDebugMap(...));" -> not compiled in release build … … 655 704 procedure TCustomAI.Unit_FindMyDefender(Loc: integer; var uix: integer); 656 705 begin 657 if Server(sGetDefender,me,Loc,uix)<rExecuted then uix:=-1 706 if Server(sGetDefender, me, Loc, uix) < rExecuted then 707 uix := -1; 658 708 end; 659 709 660 710 procedure TCustomAI.Unit_FindEnemyDefender(Loc: integer; var euix: integer); 661 711 begin 662 euix:=RO.nEnemyUn-1;663 while (euix>=0) and (RO.EnemyUn[euix].Loc<>Loc) do664 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 unit712 euix := RO.nEnemyUn - 1; 713 while (euix >= 0) and (RO.EnemyUn[euix].Loc <> Loc) do 714 Dec(euix); 715 end; 716 717 function TCustomAI.Unit_Move(uix, ToLoc: integer): integer; 718 var 719 Step: integer; 720 DestinationReached: boolean; 721 Advice: TMoveAdviceData; 722 begin 723 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0)); // is a unit 674 724 {Loc_to_ab(MyUnit[uix].Loc,ToLoc,a,b); 675 725 assert((a<>0) or (b<>0)); … … 686 736 else} 687 737 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 then738 Advice.ToLoc := ToLoc; 739 Advice.MoreTurns := 9999; 740 Advice.MaxHostile_MovementLeft := 100; 741 Result := Server(sGetMoveAdvice, me, uix, Advice); 742 end; 743 if Result = eOk then 694 744 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; 745 DestinationReached := False; 746 Step := 0; 747 repeat 748 if Result and (rExecuted or rUnitRemoved) = rExecuted then 749 // check if destination reached 750 if (ToLoc >= 0) and (Advice.MoreTurns = 0) and (Step = Advice.nStep - 1) and 751 ((Map[ToLoc] and (fUnit or fOwned) = fUnit) // attack 752 or (Map[ToLoc] and (fCity or fOwned) = fCity) and 753 ((MyModel[MyUnit[uix].mix].Domain <> dGround) // bombardment 754 or (MyModel[MyUnit[uix].mix].Flags and mdCivil <> 0))) then // can't capture 755 begin 756 DestinationReached := True; 757 break; 758 end // stop next to destination 759 else if Step = Advice.nStep then 760 DestinationReached := True; // normal move -- stop at destination 761 762 if (Step = Advice.nStep) or (Result <> eOK) and (Result <> eLoaded) then 763 break; 764 765 Result := Server(sMoveUnit + (Advice.dx[Step] and 7) shl 4 + 766 (Advice.dy[Step] and 7) shl 7, me, uix, nodata^); 767 Inc(Step); 768 if RO.Happened and phStealTech <> 0 then 769 StealAdvance; 770 until False; 771 if DestinationReached then 772 if Advice.nStep = 25 then 773 Result := Unit_Move(uix, ToLoc) // Shinkansen 774 else if Advice.MoreTurns = 0 then 775 Result := Result or rLocationReached 776 else 777 Result := Result or rMoreTurns; 778 end; 779 end; 780 781 function TCustomAI.Unit_Step(uix, ToLoc: integer): integer; 782 var 783 a, b: integer; 784 begin 785 Loc_to_ab(MyUnit[uix].Loc, ToLoc, a, b); 786 assert(((a <> 0) or (b <> 0)) and (a >= -1) and (a <= 1) and (b >= -1) and (b <= 1)); 787 Result := Server(sMoveUnit + ((a - b) and 7) shl 4 + ((a + b) and 7) shl 7, me, uix, nodata^); 788 if RO.Happened and phStealTech <> 0 then 789 StealAdvance; 790 end; 791 792 function TCustomAI.Unit_Attack(uix, ToLoc: integer): integer; 793 var 794 a, b: integer; 795 begin 796 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 797 and ((Map[ToLoc] and (fUnit or fOwned) = fUnit) // is an attack 798 or (Map[ToLoc] and (fCity or fOwned) = fCity) and 799 (MyModel[MyUnit[uix].mix].Domain <> dGround))); // is a bombardment 800 Loc_to_ab(MyUnit[uix].Loc, ToLoc, a, b); 801 assert(((a <> 0) or (b <> 0)) and (a >= -1) and (a <= 1) and (b >= -1) and (b <= 1)); 802 // attack to adjacent tile 803 Result := Server(sMoveUnit + (a - b) and 7 shl 4 + (a + b) and 7 shl 7, me, uix, nodata^); 804 end; 805 806 function TCustomAI.Unit_DoMission(uix, MissionType, ToLoc: integer): integer; 807 var 808 a, b: integer; 809 begin 810 Result := Server(sSetSpyMission + MissionType shl 4, me, 0, nodata^); 811 if Result >= rExecuted then 812 begin 813 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 814 and (MyModel[MyUnit[uix].mix].Kind = mkDiplomat)); // is a commando 815 Loc_to_ab(MyUnit[uix].Loc, ToLoc, a, b); 816 assert(((a <> 0) or (b <> 0)) and (a >= -1) and (a <= 1) and (b >= -1) and (b <= 1)); 817 // city must be adjacent 818 Result := Server(sMoveUnit - sExecute + (a - b) and 7 shl 4 + (a + b) and 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, me, uix, nodata^) 821 else if (Result <> eNoTime_Move) and (Result <> eTreaty) and (Result <> eNoTurn) then 822 Result := eInvalid; // not a special commando mission! 823 end; 824 end; 825 826 function TCustomAI.Unit_MoveForecast(uix, ToLoc: integer; 827 var RemainingMovement: integer): boolean; 828 var 829 Advice: TMoveAdviceData; 830 begin 831 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0)); // is a unit 832 Advice.ToLoc := ToLoc; 833 Advice.MoreTurns := 0; 834 Advice.MaxHostile_MovementLeft := 100; 835 if Server(sGetMoveAdvice, me, uix, Advice) = eOk then 836 begin 837 RemainingMovement := Advice.MaxHostile_MovementLeft; 838 Result := True; 722 839 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 840 else 754 841 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 842 RemainingMovement := -1; 843 Result := False; 844 end; 845 end; 846 847 // negative RemainingHealth is remaining helth of defender if lost 848 function TCustomAI.Unit_AttackForecast(uix, ToLoc, AttackMovement: integer; 849 var RemainingHealth: integer): boolean; 850 var 851 BattleForecast: TBattleForecast; 852 begin 853 assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 854 and (Map[ToLoc] and (fUnit or fOwned) = fUnit)); // is an attack 855 RemainingHealth := -$100; 856 Result := False; 857 if AttackMovement >= 0 then 858 with MyUnit[uix] do 859 begin 860 BattleForecast.pAtt := me; 861 BattleForecast.mixAtt := mix; 862 BattleForecast.HealthAtt := Health; 863 BattleForecast.ExpAtt := Exp; 864 BattleForecast.FlagsAtt := Flags; 865 BattleForecast.Movement := AttackMovement; 866 if Server(sGetBattleForecast, me, ToLoc, BattleForecast) >= rExecuted then 867 begin 868 if BattleForecast.EndHealthAtt > 0 then 869 RemainingHealth := BattleForecast.EndHealthAtt 870 else 871 RemainingHealth := -BattleForecast.EndHealthDef; 872 Result := True; 873 end; 874 end; 875 end; 876 877 function TCustomAI.Unit_DefenseForecast(euix, ToLoc: integer; 878 var RemainingHealth: integer): boolean; 879 var 880 BattleForecast: TBattleForecast; 881 begin 882 assert((euix >= 0) and (euix < RO.nEnemyUn) and (RO.EnemyUn[euix].Loc >= 0) // is an enemy unit 883 and (Map[ToLoc] and (fUnit or fOwned) = (fUnit or fOwned))); // is an attack 884 RemainingHealth := $100; 885 Result := False; 886 with RO.EnemyUn[euix] do 777 887 begin 778 RemainingMovement:=Advice.MaxHostile_MovementLeft; 779 result:=true 780 end 781 else 888 BattleForecast.pAtt := Owner; 889 BattleForecast.mixAtt := mix; 890 BattleForecast.HealthAtt := Health; 891 BattleForecast.ExpAtt := Exp; 892 BattleForecast.FlagsAtt := Flags; 893 BattleForecast.Movement := 100; 894 if Server(sGetBattleForecast, me, ToLoc, BattleForecast) >= rExecuted then 895 begin 896 if BattleForecast.EndHealthDef > 0 then 897 RemainingHealth := BattleForecast.EndHealthDef 898 else 899 RemainingHealth := -BattleForecast.EndHealthAtt; 900 Result := True; 901 end; 902 end; 903 end; 904 905 function TCustomAI.Unit_Disband(uix: integer): integer; 906 begin 907 Result := Server(sRemoveUnit, me, uix, nodata^); 908 end; 909 910 function TCustomAI.Unit_StartJob(uix, NewJob: integer): integer; 911 begin 912 Result := Server(sStartJob + NewJob shl 4, me, uix, nodata^); 913 end; 914 915 function TCustomAI.Unit_SetHomeHere(uix: integer): integer; 916 begin 917 Result := Server(sSetUnitHome, me, uix, nodata^); 918 end; 919 920 function TCustomAI.Unit_Load(uix: integer): integer; 921 begin 922 Result := Server(sLoadUnit, me, uix, nodata^); 923 end; 924 925 function TCustomAI.Unit_Unload(uix: integer): integer; 926 begin 927 Result := Server(sUnloadUnit, me, uix, nodata^); 928 end; 929 930 function TCustomAI.Unit_AddToCity(uix: integer): integer; 931 begin 932 Result := Server(sAddToCity, me, uix, nodata^); 933 end; 934 935 function TCustomAI.Unit_SelectTransport(uix: integer): integer; 936 begin 937 Result := Server(sSelectTransport, me, uix, nodata^); 938 end; 939 940 941 procedure TCustomAI.City_FindMyCity(Loc: integer; var cix: integer); 942 begin 943 if Map[Loc] and (fCity or fOwned) <> fCity or fOwned then 944 cix := -1 945 else 782 946 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 947 cix := RO.nCity - 1; 948 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 949 Dec(cix); 950 end; 951 end; 952 953 procedure TCustomAI.City_FindEnemyCity(Loc: integer; var ecix: integer); 954 begin 955 if Map[Loc] and (fCity or fOwned) <> fCity then 956 ecix := -1 957 else 799 958 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 812 end 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 959 ecix := RO.nEnemyCity - 1; 960 while (ecix >= 0) and (RO.EnemyCity[ecix].Loc <> Loc) do 961 Dec(ecix); 962 end; 963 end; 964 965 function TCustomAI.City_HasProject(cix: integer): boolean; 966 begin 967 Result := MyCity[cix].Project and (cpImp + cpIndex) <> cpImp + imTrGoods; 968 end; 969 970 function TCustomAI.City_CurrentImprovementProject(cix: integer): integer; 971 begin 972 if MyCity[cix].Project and cpImp = 0 then 973 Result := -1 974 else 826 975 begin 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 884 begin 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 896 begin 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 912 begin 913 result:=MyCity[cix].Project and cpIndex; 914 if result=imTrGoods then result:=-1 915 end 976 Result := MyCity[cix].Project and cpIndex; 977 if Result = imTrGoods then 978 Result := -1; 979 end; 916 980 end; 917 981 918 982 function TCustomAI.City_CurrentUnitProject(cix: integer): integer; 919 983 begin 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) 984 if MyCity[cix].Project and cpImp <> 0 then 985 Result := -1 986 else 987 Result := MyCity[cix].Project and cpIndex; 988 end; 989 990 function TCustomAI.City_GetTileInfo(cix, TileLoc: integer; 991 var TileInfo: TTileInfo): integer; 992 begin 993 TileInfo.ExplCity := cix; 994 Result := Server(sGetHypoCityTileInfo, me, TileLoc, TileInfo); 928 995 end; 929 996 930 997 function TCustomAI.City_GetReport(cix: integer; var Report: TCityReport): integer; 931 998 begin 932 Report.HypoTiles:=-1;933 Report.HypoTax:=-1;934 Report.HypoLux:=-1;935 result:=Server(sGetCityReport,me,cix,Report) 999 Report.HypoTiles := -1; 1000 Report.HypoTax := -1; 1001 Report.HypoLux := -1; 1002 Result := Server(sGetCityReport, me, cix, Report); 936 1003 end; 937 1004 … … 939 1006 var Report: TCityReport): integer; 940 1007 begin 941 Report.HypoTiles:=HypoTiles;942 Report.HypoTax:=HypoTax;943 Report.HypoLux:=HypoLux;944 result:=Server(sGetCityReport,me,cix,Report) 1008 Report.HypoTiles := HypoTiles; 1009 Report.HypoTax := HypoTax; 1010 Report.HypoLux := HypoLux; 1011 Result := Server(sGetCityReport, me, cix, Report); 945 1012 end; 946 1013 947 1014 function TCustomAI.City_GetReportNew(cix: integer; var Report: TCityReportNew): integer; 948 1015 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;956 var Report: TCityReportNew): integer;957 begin 958 Report.HypoTiles:=HypoTiles;959 Report.HypoTaxRate:=HypoTaxRate;960 Report.HypoLuxuryRate:=HypoLuxuryRate;961 result:=Server(sGetCityReportNew,me,cix,Report) 1016 Report.HypoTiles := -1; 1017 Report.HypoTaxRate := -1; 1018 Report.HypoLuxuryRate := -1; 1019 Result := Server(sGetCityReportNew, me, cix, Report); 1020 end; 1021 1022 function TCustomAI.City_GetHypoReportNew(cix, HypoTiles, HypoTaxRate, 1023 HypoLuxuryRate: integer; var Report: TCityReportNew): integer; 1024 begin 1025 Report.HypoTiles := HypoTiles; 1026 Report.HypoTaxRate := HypoTaxRate; 1027 Report.HypoLuxuryRate := HypoLuxuryRate; 1028 Result := Server(sGetCityReportNew, me, cix, Report); 962 1029 end; 963 1030 964 1031 function TCustomAI.City_GetAreaInfo(cix: integer; var AreaInfo: TCityAreaInfo): integer; 965 1032 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) then972 // not already producing that973 result:=Server(sSetCityProject,me,cix,mix)974 end; 975 976 function TCustomAI.City_StartEmigration(cix, mix: integer;1033 Result := Server(sGetCityAreaInfo, me, cix, AreaInfo); 1034 end; 1035 1036 function TCustomAI.City_StartUnitProduction(cix, mix: integer): integer; 1037 begin 1038 if (MyCity[cix].Project and (cpImp + cpIndex) <> mix) then 1039 // not already producing that 1040 Result := Server(sSetCityProject, me, cix, mix); 1041 end; 1042 1043 function TCustomAI.City_StartEmigration(cix, mix: integer; 977 1044 AllowDisbandCity, AsConscripts: boolean): integer; 978 1045 var 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; 1046 NewProject: integer; 1047 begin 1048 NewProject := mix; 1049 if AllowDisbandCity then 1050 NewProject := NewProject or cpDisbandCity; 1051 if AsConscripts then 1052 NewProject := NewProject or cpConscripts; 1053 Result := Server(sSetCityProject, me, cix, NewProject); 1054 end; 1055 1056 function TCustomAI.City_StartImprovement(cix, iix: integer): integer; 1057 var 1058 NewProject: integer; 1059 begin 1060 NewProject := iix + cpImp; 1061 if (MyCity[cix].Project and (cpImp + cpIndex) <> NewProject) then 1062 // not already producing that 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) >= rExecuted; 1003 1072 end; 1004 1073 1005 1074 function TCustomAI.City_StopProduction(cix: integer): integer; 1006 1075 var 1007 NewProject: integer;1008 begin 1009 NewProject:=imTrGoods+cpImp;1010 result:=Server(sSetCityProject,me,cix,NewProject) 1076 NewProject: integer; 1077 begin 1078 NewProject := imTrGoods + cpImp; 1079 Result := Server(sSetCityProject, me, cix, NewProject); 1011 1080 end; 1012 1081 1013 1082 function TCustomAI.City_BuyProject(cix: integer): integer; 1014 1083 begin 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) 1084 Result := Server(sBuyCityProject, me, cix, nodata^); 1085 end; 1086 1087 function TCustomAI.City_SellImprovement(cix, iix: integer): integer; 1088 begin 1089 Result := Server(sSellCityImprovement, me, cix, iix); 1090 end; 1091 1092 function TCustomAI.City_RebuildImprovement(cix, iix: integer): integer; 1093 begin 1094 Result := Server(sRebuildCityImprovement, me, cix, iix); 1095 end; 1096 1097 function TCustomAI.City_SetTiles(cix, NewTiles: integer): integer; 1098 begin 1099 Result := Server(sSetCityTiles, me, cix, NewTiles); 1031 1100 end; 1032 1101 1033 1102 procedure TCustomAI.City_OptimizeTiles(cix: integer; ResourceWeights: cardinal); 1034 1103 var 1035 Advice: TCityTileAdviceData;1036 begin 1037 Advice.ResourceWeights:=ResourceWeights;1038 Server(sGetCityTileAdvice, me, cix, Advice);1039 City_SetTiles(cix, Advice.Tiles);1104 Advice: TCityTileAdviceData; 1105 begin 1106 Advice.ResourceWeights := ResourceWeights; 1107 Server(sGetCityTileAdvice, me, cix, Advice); 1108 City_SetTiles(cix, Advice.Tiles); 1040 1109 end; 1041 1110 … … 1044 1113 function TCustomAI.Nego_CheckMyAction: integer; 1045 1114 begin 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^); 1115 assert(Opponent >= 0); // only allowed in negotiation mode 1116 assert((MyAction = scDipNotice) or (MyAction = scDipAccept) or 1117 (MyAction = scDipCancelTreaty) or (MyAction = scDipOffer) or (MyAction = scDipBreak)); 1118 if MyAction = scDipOffer then 1119 Result := Server(MyAction - sExecute, me, 0, MyOffer) 1120 else 1121 Result := Server(MyAction - sExecute, me, 0, nodata^); 1052 1122 end; 1053 1123 1054 1124 1055 1125 initialization 1056 nodata:=pointer(0);1057 RWDataSize:=0;1126 nodata := pointer(0); 1127 RWDataSize := 0; 1058 1128 1059 1129 end. 1060 -
branches/highdpi/AI/StdAI/Names.pas
r210 r303 4 4 5 5 uses 6 Protocol;6 Protocol; 7 7 8 8 const 9 9 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');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'); 230 230 231 231 implementation 232 232 233 233 end. 234 -
branches/highdpi/AI/StdAI/Pile.pas
r210 r303 19 19 20 20 const 21 MaxSize=9600;21 MaxSize = 9600; 22 22 23 23 type 24 TheapItem = record25 Item:integer;26 Value:integer;27 end;24 TheapItem = record 25 Item: integer; 26 Value: integer; 27 end; 28 28 29 29 var 30 bh: array[0..MaxSize-1] of TheapItem;31 Ix: array[0..MaxSize-1] of integer;32 n, CurrentSize: integer;30 bh: array[0..MaxSize - 1] of TheapItem; 31 Ix: array[0..MaxSize - 1] of integer; 32 n, CurrentSize: integer; 33 33 {$IFDEF DEBUG}InUse: boolean;{$ENDIF} 34 34 … … 36 36 procedure Create(Size: integer); 37 37 begin 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} 38 {$IFDEF DEBUG} 39 assert(not InUse, 'Pile is a single instance class, ' + 40 'no multiple usage possible. Always call Pile.Free after use.'); 41 {$ENDIF} 42 assert(Size <= MaxSize); 43 if (n <> 0) or (Size > CurrentSize) then 44 begin 45 FillChar(Ix, Size * sizeOf(integer), 255); 46 n := 0; 47 end; 48 CurrentSize := Size; 49 {$IFDEF DEBUG} 50 InUse := True; 51 {$ENDIF} 48 52 end; 49 53 50 54 procedure Free; 51 55 begin 52 {$IFDEF DEBUG}assert(InUse);InUse:=false;{$ENDIF} 56 {$IFDEF DEBUG} 57 assert(InUse); 58 InUse := False; 59 {$ENDIF} 53 60 end; 54 61 55 62 procedure Empty; 56 63 begin 57 58 59 FillChar(Ix, CurrentSize*sizeOf(integer), 255);60 61 64 if n <> 0 then 65 begin 66 FillChar(Ix, CurrentSize * sizeOf(integer), 255); 67 n := 0; 68 end; 62 69 end; 63 70 … … 65 72 function Put(Item, Value: integer): boolean; //O(lg(n)) 66 73 var 67 i, j:integer;74 i, j: integer; 68 75 begin 69 assert(Item<CurrentSize);70 71 72 73 74 75 result := False;76 77 78 79 80 81 82 83 76 assert(Item < CurrentSize); 77 i := Ix[Item]; 78 if i >= 0 then 79 begin 80 if bh[i].Value <= Value then 81 begin 82 Result := False; 83 exit; 84 end; 85 end 86 else 87 begin 88 i := n; 89 Inc(n); 90 end; 84 91 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; 92 while i > 0 do 93 begin 94 j := (i - 1) shr 1; //Parent(i) = (i-1)/2 95 if Value >= bh[j].Value then 96 break; 97 bh[i] := bh[j]; 98 Ix[bh[i].Item] := i; 99 i := j; 100 end; 101 // Insert the new Item at the insertion point found. 102 bh[i].Value := Value; 103 bh[i].Item := Item; 104 Ix[bh[i].Item] := i; 105 Result := True; 98 106 end; 99 107 100 108 function TestPut(Item, Value: integer): boolean; 101 109 var 102 110 i: integer; 103 111 begin 104 assert(Item<CurrentSize);105 106 result := (i < 0) or (bh[i].Value > Value);112 assert(Item < CurrentSize); 113 i := Ix[Item]; 114 Result := (i < 0) or (bh[i].Value > Value); 107 115 end; 108 116 … … 111 119 function Get(var Item, Value: integer): boolean; //O(lg(n)) 112 120 var 113 i, j:integer;114 last:TheapItem;121 i, j: integer; 122 last: TheapItem; 115 123 begin 116 117 118 result := False;119 120 124 if n = 0 then 125 begin 126 Result := False; 127 exit; 128 end; 121 129 122 123 130 Item := bh[0].Item; 131 Value := bh[0].Value; 124 132 125 133 Ix[Item] := -1; 126 134 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; 135 Dec(n); 136 if n > 0 then 137 begin 138 last := bh[n]; 139 i := 0; 140 j := 1; 141 while j < n do 142 begin 143 // Right(i) = Left(i)+1 144 if (j < n - 1) and (bh[j].Value > bh[j + 1].Value) then 145 Inc(j); 146 if last.Value <= bh[j].Value then 147 break; 138 148 139 140 141 142 j := j shl 1+1;//Left(j) = 2*j+1143 149 bh[i] := bh[j]; 150 Ix[bh[i].Item] := i; 151 i := j; 152 j := j shl 1 + 1; //Left(j) = 2*j+1 153 end; 144 154 145 146 147 148 149 result := True 155 // Insert the root in the correct place in the heap. 156 bh[i] := last; 157 Ix[last.Item] := i; 158 end; 159 Result := True; 150 160 end; 151 161 152 162 initialization 153 n:=0; 154 CurrentSize:=0; 155 {$IFDEF DEBUG}InUse:=false;{$ENDIF} 163 n := 0; 164 CurrentSize := 0; 165 {$IFDEF DEBUG} 166 InUse := False; 167 {$ENDIF} 156 168 end. 157 -
branches/highdpi/AI/StdAI/Protocol.pas
r210 r303 44 44 MaxMoneyPrice = $FFFF; 45 45 MaxShipPartPrice = 100; 46 BombardmentDestroysCity = false;46 BombardmentDestroysCity = False; 47 47 StartMoney = 0; 48 48 InitialCredibility = 95; … … 53 53 // difficulty settings 54 54 MaxDiff = 4; { maximum difficulty level } 55 StorageSize: array [1 .. MaxDiff] of integer = (30, 40, 50, 60);56 TechFormula_M: array [1 .. MaxDiff] of single = (2.0, 2.3, 2.6, 4.0);57 TechFormula_D: array [1 .. MaxDiff] of single = (102.0, 80.0, 64.0, 64.0);58 BuildCostMod: array [1 .. MaxDiff] of integer = (9, 12, 15, 18); // in 1/1255 StorageSize: array [1 .. MaxDiff] of Integer = (30, 40, 50, 60); 56 TechFormula_M: array [1 .. MaxDiff] of Single = (2.0, 2.3, 2.6, 4.0); 57 TechFormula_D: array [1 .. MaxDiff] of Single = (102.0, 80.0, 64.0, 64.0); 58 BuildCostMod: array [1 .. MaxDiff] of Integer = (9, 12, 15, 18); // in 1/12 59 59 60 60 // test flags … … 795 795 imShipHab = 69; 796 796 797 SettlerFood: array [0 .. nGov - 1] of integer = (1, 1, 1, 2, 1, 2, 2, 2);798 CorrLevel: array [0 .. nGov - 1] of integer = (3, 3, 1, 2, 1, 0, 0, 0);799 SupportFree: array [0 .. nGov - 1] of integer = (2, 2, 1, 0, 2, 1, 0, 0);797 SettlerFood: array [0 .. nGov - 1] of Integer = (1, 1, 1, 2, 1, 2, 2, 2); 798 CorrLevel: array [0 .. nGov - 1] of Integer = (3, 3, 1, 2, 1, 0, 0, 0); 799 SupportFree: array [0 .. nGov - 1] of Integer = (2, 2, 1, 0, 2, 1, 0, 0); 800 800 // in 1/2*city size 801 801 … … 808 808 preNA = -$FF; 809 809 810 JobPreq: array [0 .. nJob - 1] of integer = (preNone, preNone, adRailroad,810 JobPreq: array [0 .. nJob - 1] of Integer = (preNone, preNone, adRailroad, 811 811 preNone, preNone, adRefrigeration, preNone, preNone, adExplosives, 812 812 adExplosives, adConstruction, preNone, adMedicine, preNone, preNone); 813 813 814 AdvPreq: array [0 .. nAdv - 1, 0 .. 2] of integer = { advance prerequisites }814 AdvPreq: array [0 .. nAdv - 1, 0 .. 2] of Integer = { advance prerequisites } 815 815 ((adFlight, adRobotics, preNone), // adAdvancedFlight 816 816 (adNavigation, adTactics, preNone), // adAmphibiousWarfare … … 1023 1023 spPow = 1; 1024 1024 spHab = 2; 1025 ShipNeed: array [0 .. nShipPart - 1] of integer = (6, 4, 2);1026 ShipImpIndex: array [0 .. nShipPart - 1] of integer = (imShipComp, imShipPow, imShipHab);1027 1028 GovPreq: array [1 .. nGov - 1] of integer = { government prerequisites }1025 ShipNeed: array [0 .. nShipPart - 1] of Integer = (6, 4, 2); 1026 ShipImpIndex: array [0 .. nShipPart - 1] of Integer = (imShipComp, imShipPow, imShipHab); 1027 1028 GovPreq: array [1 .. nGov - 1] of Integer = { government prerequisites } 1029 1029 (preNone, adMonarchy, adTheRepublic, adTheology, adCommunism, adDemocracy, 1030 1030 adInternet); 1031 1031 1032 AgePreq: array [1 .. 3] of integer = (adScience, adMassProduction,1032 AgePreq: array [1 .. 3] of Integer = (adScience, adMassProduction, 1033 1033 adTransstellarColonization); 1034 1034 … … 1044 1044 TransTerrain: Integer; 1045 1045 TransWork: Integer; 1046 FoodRes, ProdRes, TradeRes: array [0 .. 2] of Integer; 1046 FoodRes: array [0 .. 2] of Integer; 1047 ProdRes: array [0 .. 2] of Integer; 1048 TradeRes: array [0 .. 2] of Integer; 1047 1049 Filler: array [0 .. 12] of Integer; 1048 1050 end … … 1113 1115 // cost values accumulate if prerequisite is future tech / are maximized if not 1114 1116 nUpgrade = 15; 1115 upgrade: 1116 array [0 .. nDomains - 1, 0 .. nUpgrade - 1] of record 1117 upgrade: array [0 .. nDomains - 1, 0 .. nUpgrade - 1] of record 1117 1118 Preq: Integer; 1118 1119 Strength: Integer; … … 1201 1202 1202 1203 Feature: array [0 .. nFeature - 1] of { unit model features } 1203 record Domains, Preq, Weight, Cost: integer; 1204 end 1204 record 1205 Domains: Integer; 1206 Preq: Integer; 1207 Weight: Integer; 1208 Cost: Integer; 1209 end 1205 1210 = ((Domains: 7; Preq: preNone; Weight: 1; Cost: 1), { mcOffense } 1206 1211 (Domains: 7; Preq: preNone; Weight: 1; Cost: 1), { mcDefense } … … 1231 1236 (Domains: 7; Preq: adMassProduction; Weight: 0; Cost: 0)); { mcLine } 1232 1237 1233 WeightPreq7: array [0 .. nDomains - 1] of integer = (adHorsebackRiding, adSeafaring,1238 WeightPreq7: array [0 .. nDomains - 1] of Integer = (adHorsebackRiding, adSeafaring, 1234 1239 adAdvancedFlight); 1235 WeightPreq10: array [0 .. nDomains - 1] of integer = (adAutomobile, adSteel, preNA);1240 WeightPreq10: array [0 .. nDomains - 1] of Integer = (adAutomobile, adSteel, preNA); 1236 1241 1237 1242 INFIN = 999999; … … 1261 1266 1262 1267 type 1263 TServerCall = function (Command, Player, Subject: integer; var Data)1264 : integer; stdcall;1265 TClientCall = procedure (Command, Player: integer; var Data); stdcall;1268 TServerCall = function (Command, Player, Subject: Integer; var Data) 1269 : Integer; stdcall; 1270 TClientCall = procedure (Command, Player: Integer; var Data); stdcall; 1266 1271 1267 1272 TUn = packed record 1268 Loc ,{ location }1269 Status ,// free for AI use1273 Loc: LongInt; { location } 1274 Status: LongInt; // free for AI use 1270 1275 SavedStatus: LongInt; // for server internal use only 1271 ID: word; // unit number, never changes, unique within this nation1272 mix ,{ model index }1273 Home ,{ home city index, -1 if none }1274 Master ,{ index of transporting unit, -1 if none }1276 ID: Word; // unit number, never changes, unique within this nation 1277 mix: SmallInt; { model index } 1278 Home: SmallInt; { home city index, -1 if none } 1279 Master: SmallInt; { index of transporting unit, -1 if none } 1275 1280 Movement: SmallInt; { movement left for this turn } 1276 Health ,// = 100-Damage1281 Health: ShortInt; // = 100-Damage 1277 1282 Fuel: ShortInt; 1278 Job ,{ current terrain improvement job }1279 Exp ,{ micro experience, the level is Exp div ExpCost }1280 TroopLoad ,{ number of transported ground units }1283 Job: Byte; { current terrain improvement job } 1284 Exp: Byte; { micro experience, the level is Exp div ExpCost } 1285 TroopLoad: Byte; { number of transported ground units } 1281 1286 AirLoad: Byte; // number of transported air units 1282 1287 Flags: Cardinal; 1283 1288 end; 1284 1289 1290 { TCity } 1291 1285 1292 TCity = packed record 1286 Loc ,{ location }1287 Status ,// free for AI use1293 Loc: LongInt; { location } 1294 Status: LongInt; // free for AI use 1288 1295 SavedStatus: LongInt; // for server internal use only 1289 ID ,// founding player shl 12 + number, never changes, unique within the whole game1290 Size: word;1291 Project ,// current production project, see city project flags1292 Project0 ,// for server use only1293 Food ,// collected food in storage1294 Pollution ,// collected pollution in dump1295 Prod ,// for project collected production points1296 ID: Word; // founding player shl 12 + number, never changes, unique within the whole game 1297 Size: Word; 1298 Project: SmallInt; // current production project, see city project flags 1299 Project0: SmallInt; // for server use only 1300 Food: SmallInt; // collected food in storage 1301 Pollution: SmallInt; // collected pollution in dump 1302 Prod: SmallInt; // for project collected production points 1296 1303 Prod0: SmallInt; 1297 1304 // for project collected production points in the beginning of the turn 1298 Flags ,// what happened within the last turnaround1299 Tiles ,{ currently by city exploited tiles, bitset with index1305 Flags: Cardinal; // what happened within the last turnaround 1306 Tiles: Cardinal; { currently by city exploited tiles, bitset with index 1300 1307 (dy+3) shl 2+(dx+3) shr 1, (dx,dy) relative to central tile } 1301 1308 N1: Cardinal; // reserved for future use … … 1305 1312 1306 1313 TModel = packed record 1307 Status ,// free for AI use1314 Status: LongInt; // free for AI use 1308 1315 SavedStatus: LongInt; // for server internal use only 1309 ID, // developing player shl 12 + number, never changes, unique within the whole game 1310 IntroTurn, Built, // units built with this model 1311 Lost: word; // units of this model lost in combat 1312 Kind, Domain: Byte; 1313 Attack, Defense, Speed, Cost, MStrength: word; 1316 ID: Word; // developing player shl 12 + number, never changes, unique within the whole game 1317 IntroTurn: Word; 1318 Built: Word; // units built with this model 1319 Lost: Word; // units of this model lost in combat 1320 Kind: Byte; 1321 Domain: Byte; 1322 Attack: Word; 1323 Defense: Word; 1324 Speed: Word; 1325 Cost: Word; 1326 MStrength: Word; 1314 1327 // construction time multipliers, only valid if kind is mkSelfDeveloped or mkEnemyDeveloped 1315 MTrans, MCost, Weight, MaxWeight: Byte; 1328 MTrans: Byte; 1329 MCost: Byte; 1330 Weight: Byte; 1331 MaxWeight: Byte; 1316 1332 // weight and maximum weight (construction time) 1317 Upgrades ,// bitarray indicating all upgrades1333 Upgrades: Cardinal; // bitarray indicating all upgrades 1318 1334 Flags: Cardinal; 1319 1335 Cap: array [0 .. (nFeature + 3) div 4 * 4 - 1] of Byte; // special features … … 1322 1338 TUnitInfo = packed record 1323 1339 Loc: LongInt; 1324 mix ,// index of unit model for its owner1325 emix: word; // index in enemy model list1340 mix: Word; // index of unit model for its owner 1341 emix: Word; // index in enemy model list 1326 1342 Owner: Byte; 1327 Health ,// = 100-Damage1343 Health: ShortInt; // = 100-Damage 1328 1344 Fuel: ShortInt; 1329 Job ,// current terrain improvement job1330 Exp ,{ micro experience, the level is Exp div ExpCost }1345 Job: Byte; // current terrain improvement job 1346 Exp: Byte; { micro experience, the level is Exp div ExpCost } 1331 1347 Load: Byte; { number of transported units } 1332 Flags: word;1348 Flags: Word; 1333 1349 end; 1334 1350 1335 1351 TCityInfo = packed record 1336 Loc, Status, // free for AI use 1352 Loc: LongInt; 1353 Status: LongInt; // free for AI use 1337 1354 SavedStatus: LongInt; // for server internal use only 1338 Owner, // last known owner, even if not alive anymore! 1339 ID, // founding player <<12 + number, never changes, unique within the whole game 1340 Size, Flags: word; 1355 Owner: Word; // last known owner, even if not alive anymore! 1356 ID: Word; // founding player <<12 + number, never changes, unique within the whole game 1357 Size: Word; 1358 Flags: Word; 1341 1359 end; 1342 1360 1343 1361 TModelInfo = packed record 1344 Owner, // Player which owns the model 1345 mix, // index of unit model for its owner 1346 ID: word; // developing player shl 12 + number, never changes, unique within the whole game 1347 Kind, Domain: Byte; 1348 Attack, Defense, Speed, Cost: word; 1349 TTrans, // ground unit transport capability 1362 Owner: Word; // Player which owns the model 1363 mix: Word; // index of unit model for its owner 1364 ID: Word; // developing player shl 12 + number, never changes, unique within the whole game 1365 Kind: Byte; 1366 Domain: Byte; 1367 Attack: Word; 1368 Defense: Word; 1369 Speed: Word; 1370 Cost: Word; 1371 TTrans: Byte; // ground unit transport capability 1350 1372 ATrans_Fuel: Byte; // air unit transport capability resp. fuel 1351 Bombs: word; // additional attack with bombs1373 Bombs: Word; // additional attack with bombs 1352 1374 Cap: Cardinal; // special features, bitset with index Feature-mcFirstNonCap 1353 MaxUpgrade ,// maximum used upgrade1375 MaxUpgrade: Byte; // maximum used upgrade 1354 1376 Weight: Byte; 1355 Lost: word;1377 Lost: Word; 1356 1378 end; 1357 1379 1358 1380 TBattle = packed record 1359 Enemy, Flags: Byte; 1360 Turn, mix, mixEnemy: word; 1361 ToLoc, FromLoc: integer; 1381 Enemy: Byte; 1382 Flags: Byte; 1383 Turn: Word; 1384 mix: Word; 1385 mixEnemy: Word; 1386 ToLoc: Integer; 1387 FromLoc: Integer; 1362 1388 end; 1363 1389 1364 1390 TWonderInfo = record 1365 CityID ,// -2 if destroyed, -1 if never completed, >=0 ID of city1366 EffectiveOwner: integer1391 CityID: Integer; // -2 if destroyed, -1 if never completed, >=0 ID of city 1392 EffectiveOwner: Integer; 1367 1393 // owning player if effective, -1 if expired or not built 1368 end; 1369 1370 TShipInfo = record Parts: array [0 .. nShipPart - 1] of integer; 1394 end; 1395 1396 TShipInfo = record 1397 Parts: array [0 .. nShipPart - 1] of Integer; 1371 1398 end; 1372 1399 1373 1400 TEnemyReport = record 1374 TurnOfContact, TurnOfCivilReport, TurnOfMilReport, Attitude, 1375 Credibility: integer; // 0..100, last update: ToC 1376 Treaty: array [0 .. nPl - 1] of integer; 1401 TurnOfContact: Integer; 1402 TurnOfCivilReport: Integer; 1403 TurnOfMilReport: Integer; 1404 Attitude: Integer; 1405 Credibility: Integer; // 0..100, last update: ToC 1406 Treaty: array [0 .. nPl - 1] of Integer; 1377 1407 // diplomatic status with other nations, last update: ToCR 1378 Government, // gAnarchy..gDemocracy, last update: ToCR 1379 Money, // last update: ToCR 1380 ResearchTech, ResearchDone: integer; // last update: ToCR 1408 Government: Integer; // gAnarchy..gDemocracy, last update: ToCR 1409 Money: Integer; // last update: ToCR 1410 ResearchTech: Integer; // last update: ToCR 1411 ResearchDone: Integer; // last update: ToCR 1381 1412 Tech: array [0 .. (nAdv + 3) div 4 * 4 - 1] of ShortInt; 1382 1413 // tech status indicator, last update: ToCR 1383 nModelCounted: integer;1414 nModelCounted: Integer; 1384 1415 // number of models with info in UnCount, last update: ToMR 1385 UnCount: array [0 .. INFIN] of word;1416 UnCount: array [0 .. INFIN] of Word; 1386 1417 // number of available units for each model, last update: ToMR 1387 1418 end; 1388 1419 1389 1420 TMoveAdviceData = record 1390 ToLoc, nStep, MoreTurns, MaxHostile_MovementLeft: integer; 1391 dx, dy: array [0 .. 24] of integer; 1421 ToLoc: Integer; 1422 nStep: Integer; 1423 MoreTurns: Integer; 1424 MaxHostile_MovementLeft: Integer; 1425 dx: array [0 .. 24] of Integer; 1426 dy: array [0 .. 24] of Integer; 1392 1427 end; 1393 1428 1394 1429 TPlaneReturnData = record 1395 Loc, Fuel, Movement: integer; 1430 Loc: Integer; 1431 Fuel: Integer; 1432 Movement: Integer; 1396 1433 end; 1397 1434 1398 1435 TTileInfo = record 1399 Food, Prod, Trade, ExplCity: integer; 1436 Food: Integer; 1437 Prod: Integer; 1438 Trade: Integer; 1439 ExplCity: Integer; 1400 1440 end; 1401 1441 1402 1442 TCityReport = record 1403 HypoTiles, HypoTax, HypoLux, Working, Happy, FoodRep, 1404 ProdRep, Trade, PollRep, Corruption, Tax, Lux, Science, Support, Eaten, 1405 ProdCost, Storage, Deployed: integer; 1443 HypoTiles: Integer; 1444 HypoTax: Integer; 1445 HypoLux: Integer; 1446 Working: Integer; 1447 Happy: Integer; 1448 FoodRep: Integer; 1449 ProdRep: Integer; 1450 Trade: Integer; 1451 PollRep: Integer; 1452 Corruption: Integer; 1453 Tax: Integer; 1454 Lux: Integer; 1455 Science: Integer; 1456 Support: Integer; 1457 Eaten: Integer; 1458 ProdCost: Integer; 1459 Storage: Integer; 1460 Deployed: Integer; 1406 1461 end; 1407 1462 1408 1463 TCityReportNew = record 1409 HypoTiles ,1464 HypoTiles: Integer; 1410 1465 // tiles that should be considered as exploited (for the current adjustment, set this to -1 or to TCity.Tiles of the city) 1411 HypoTaxRate, HypoLuxuryRate, 1466 HypoTaxRate: Integer; 1467 HypoLuxuryRate: Integer; 1412 1468 // tax and luxury rate that should be assumed (for current rates, set this to -1 or to RO.TaxRate resp. RO.LuxRate) 1413 Morale, FoodSupport, MaterialSupport, 1469 Morale: Integer; 1470 FoodSupport: Integer; 1471 MaterialSupport: Integer; 1414 1472 // food and material taken for unit support 1415 ProjectCost, // material cost of current project 1416 Storage, // size of food storage 1417 Deployed, // number of units causing unrest (unrest=2*deployed) 1418 CollectedControl, CollectedFood, CollectedMaterial, CollectedTrade, 1473 ProjectCost: Integer; // material cost of current project 1474 Storage: Integer; // size of food storage 1475 Deployed: Integer; // number of units causing unrest (unrest=2*deployed) 1476 CollectedControl: Integer; 1477 CollectedFood: Integer; 1478 CollectedMaterial: Integer; 1479 CollectedTrade: Integer; 1419 1480 // raw control, food, material and trade as collected by the citizens 1420 Working, // number of exploited tiles including city tile 1421 FoodSurplus, Production, AddPollution, 1481 Working: Integer; // number of exploited tiles including city tile 1482 FoodSurplus: Integer; 1483 Production: Integer; 1484 AddPollution: Integer; 1422 1485 // food surplus, production gain and pollution after all effects 1423 Corruption, Tax, Science, Luxury, 1486 Corruption: Integer; 1487 Tax: Integer; 1488 Science: Integer; 1489 Luxury: Integer; 1424 1490 // corruption, tax, science and wealth after all effects 1425 HappinessBalance: integer;1491 HappinessBalance: Integer; 1426 1492 // = (Morale+Wealth+Control) - (Size+Unrest), value < 0 means disorder 1427 1493 end; 1428 1494 1429 1495 TCityTileAdviceData = record 1430 ResourceWeights, Tiles: Cardinal; 1496 ResourceWeights: Cardinal; 1497 Tiles: Cardinal; 1431 1498 CityReport: TCityReport; 1432 1499 end; 1433 1500 1434 1501 TGetCityData = record 1435 Owner: integer;1502 Owner: Integer; 1436 1503 c: TCity; 1437 1504 end; 1438 1505 1439 1506 TCityAreaInfo = record 1440 Available: array [0 .. 26] of integer;1507 Available: array [0 .. 26] of Integer; 1441 1508 end; 1442 1509 1443 1510 TUnitReport = record 1444 FoodSupport, ProdSupport, ReportFlags: integer; 1511 FoodSupport: Integer; 1512 ProdSupport: Integer; 1513 ReportFlags: Integer; 1445 1514 end; 1446 1515 1447 1516 TJobProgressData = array [0 .. nJob - 1] of record 1448 1517 Required, Done, 1449 NextTurnPlus: integer; 1450 end; 1518 NextTurnPlus: Integer; 1519 end; 1520 1451 1521 TBattleForecast = record 1452 pAtt, mixAtt, HealthAtt, ExpAtt, FlagsAtt, Movement, 1453 EndHealthDef, EndHealthAtt: integer; 1454 end; 1522 pAtt: Integer; 1523 mixAtt: Integer; 1524 HealthAtt: Integer; 1525 ExpAtt: Integer; 1526 FlagsAtt: Integer; 1527 Movement: Integer; 1528 EndHealthDef: Integer; 1529 EndHealthAtt: Integer; 1530 end; 1531 1455 1532 TBattleForecastEx = record 1456 pAtt, mixAtt, HealthAtt, ExpAtt, FlagsAtt, Movement, 1457 EndHealthDef, EndHealthAtt: integer; // must be same as in TBattleForecast 1458 AStr, DStr, ABaseDamage, DBaseDamage: integer; 1459 end; 1533 pAtt: Integer; 1534 mixAtt: Integer; 1535 HealthAtt: Integer; 1536 ExpAtt: Integer; 1537 FlagsAtt: Integer; 1538 Movement: Integer; 1539 EndHealthDef: Integer; 1540 EndHealthAtt: Integer; // must be same as in TBattleForecast 1541 AStr: Integer; 1542 DStr: Integer; 1543 ABaseDamage: Integer; 1544 DBaseDamage: Integer; 1545 end; 1546 1460 1547 TShowMove = record 1461 Owner, Health, mix, emix, Flags, FromLoc, dx, dy, EndHealth, 1462 EndHealthDef, Fuel, Exp, Load: integer; 1463 end; 1548 Owner: Integer; 1549 Health: Integer; 1550 mix: Integer; 1551 emix: Integer; 1552 Flags: Integer; 1553 FromLoc: Integer; 1554 dx: Integer; 1555 dy: Integer; 1556 EndHealth: Integer; 1557 EndHealthDef: Integer; 1558 Fuel: Integer; 1559 Exp: Integer; 1560 Load: Integer; 1561 end; 1562 1464 1563 TShowShipChange = record 1465 Reason, Ship1Owner, Ship2Owner: integer; 1466 Ship1Change, Ship2Change: array [0 .. nShipPart - 1] of integer; 1467 end; 1564 Reason: Integer; 1565 Ship1Owner: Integer; 1566 Ship2Owner: Integer; 1567 Ship1Change: array [0 .. nShipPart - 1] of Integer; 1568 Ship2Change: array [0 .. nShipPart - 1] of Integer; 1569 end; 1570 1468 1571 TOffer = record 1469 nDeliver, nCost: integer; 1572 nDeliver: Integer; 1573 nCost: Integer; 1470 1574 Price: array [0 .. 11] of Cardinal; 1471 1575 end; 1472 TChart = array [0 .. INFIN] of integer; 1576 1577 TChart = array [0 .. INFIN] of Integer; 1473 1578 TEditTileData = record 1474 Loc, NewTile: integer 1579 Loc: Integer; 1580 NewTile: Integer; 1475 1581 end; 1476 1582 TCreateUnitData = record 1477 Loc, p, mix: integer; 1583 Loc: Integer; 1584 p: Integer; 1585 mix: Integer; 1478 1586 end; 1479 1587 … … 1492 1600 1493 1601 TPlayerContext = record 1494 Data: pointer;1602 Data: Pointer; 1495 1603 Map: ^TTileList; 1496 1604 { the playground, a list of tiles with index = location, see tile flags } … … 1506 1614 EnemyReport: array [0 .. nPl - 1] of ^TEnemyReport; 1507 1615 1508 TestFlags, // options turned on in the "Manipulation" menu 1509 Turn, // current turn 1510 Alive, { bitset of IDs of players still alive, flag 1 shl p for player p } 1511 Happened, // flags indicate what happened within the last turnaround 1512 AnarchyStart, // start turn of anarchy, <0 if not in anarchy 1513 Credibility, // own credibility 1514 MaxCredibility, // maximum credibility still to achieve 1515 nUn, { number of units } 1516 nCity, { number of cities } 1517 nModel, { number of developed unit models } 1518 nEnemyUn, nEnemyCity, nEnemyModel, Government, { gAnarchy..gDemocracy } 1519 Money, TaxRate, LuxRate, Research, 1616 TestFlags: Integer; // options turned on in the "Manipulation" menu 1617 Turn: Integer; // current turn 1618 Alive: Integer; { bitset of IDs of players still alive, flag 1 shl p for player p } 1619 Happened: Integer; // flags indicate what happened within the last turnaround 1620 AnarchyStart: Integer; // start turn of anarchy, <0 if not in anarchy 1621 Credibility: Integer; // own credibility 1622 MaxCredibility: Integer; // maximum credibility still to achieve 1623 nUn: Integer; { number of units } 1624 nCity: Integer; { number of cities } 1625 nModel: Integer; { number of developed unit models } 1626 nEnemyUn: Integer; 1627 nEnemyCity: Integer; 1628 nEnemyModel: Integer; 1629 Government: Integer; { gAnarchy..gDemocracy } 1630 Money: Integer; 1631 TaxRate: Integer; 1632 LuxRate: Integer; 1633 Research: Integer; 1520 1634 { collected research points for currently researched tech } 1521 ResearchTech: integer; // currently researched tech1635 ResearchTech: Integer; // currently researched tech 1522 1636 DevModel: TModel; { unit model currently under development } 1523 1637 Tech: array [0 .. (nAdv + 3) div 4 * 4 - 1] of ShortInt; { tech status indicator } 1524 Attitude: array [0 .. nPl - 1] of integer; // attitude to other nations1525 Treaty: array [0 .. nPl - 1] of integer; // treaty with other nations1526 EvaStart: array [0 .. nPl - 1] of integer; // peace treaty: start of evacuation period1527 Tribute: array [0 .. nPl - 1] of integer; // no longer in use1528 TributePaid: array [0 .. nPl - 1] of integer; // no longer in use1638 Attitude: array [0 .. nPl - 1] of Integer; // attitude to other nations 1639 Treaty: array [0 .. nPl - 1] of Integer; // treaty with other nations 1640 EvaStart: array [0 .. nPl - 1] of Integer; // peace treaty: start of evacuation period 1641 Tribute: array [0 .. nPl - 1] of Integer; // no longer in use 1642 TributePaid: array [0 .. nPl - 1] of Integer; // no longer in use 1529 1643 Wonder: array [0 .. 27] of TWonderInfo; 1530 1644 Ship: array [0 .. nPl - 1] of TShipInfo; 1531 1645 NatBuilt: array [28 .. (nImp + 3) div 4 * 4 - 1] of ShortInt; 1532 nBattleHistory: integer;1646 nBattleHistory: Integer; 1533 1647 BattleHistory: ^TBattleList; // complete list of all my battles in the whole game 1534 1648 BorderHelper: ^TByteList; 1535 LastCancelTreaty: array [0 .. nPl - 1] of integer; // turn of last treaty cancel1536 OracleIncome: integer;1649 LastCancelTreaty: array [0 .. nPl - 1] of Integer; // turn of last treaty cancel 1650 OracleIncome: Integer; 1537 1651 DefaultDebugMap: ^TIntList; 1538 1652 Filler: array [0 .. 879] of Byte; … … 1541 1655 TInitModuleData = record 1542 1656 Server: TServerCall; 1543 DataVersion, DataSize, Flags: integer; 1657 DataVersion: Integer; 1658 DataSize: Integer; 1659 Flags: Integer; 1544 1660 end; 1545 1661 1546 1662 TNewGameData = record 1547 lx, ly, LandMass, MaxTurn: integer; 1548 Difficulty: array [0 .. nPl - 1] of integer; 1663 lx: Integer; 1664 ly: Integer; 1665 LandMass: Integer; 1666 MaxTurn: Integer; 1667 Difficulty: array [0 .. nPl - 1] of Integer; 1549 1668 { difficulty levels of the players, if it's 0 this player is the supervisor, 1550 1669 -1 for unused slots } 1551 1670 RO: array [0 .. nPl - 1] of ^TPlayerContext; 1552 AssemblyPath: array [0 .. 255] of char;1671 AssemblyPath: array [0 .. 255] of Char; 1553 1672 SuperVisorRO: array [0 .. nPl - 1] of ^TPlayerContext; 1554 1673 end; 1555 1674 1556 1675 TNewGameExData = record 1557 lx, ly, LandMass, MaxTurn, RND: integer; 1558 Difficulty: array [0 .. nPl - 1] of integer; 1676 lx: Integer; 1677 ly: Integer; 1678 LandMass: Integer; 1679 MaxTurn: Integer; 1680 RND: Integer; 1681 Difficulty: array [0 .. nPl - 1] of Integer; 1559 1682 { difficulty levels of the players, if it's 0 this player is the supervisor, 1560 1683 -1 for unused slots } 1561 Controlled: integer;1684 Controlled: Integer; 1562 1685 end; 1563 1686 1564 1687 TShowNegoData = record 1565 pSender, pTarget, Action: integer; 1688 pSender: Integer; 1689 pTarget: Integer; 1690 Action: Integer; 1566 1691 Offer: TOffer; 1567 1692 end; … … 1632 1757 { preLeo,preLighthouse, } preLeo); 1633 1758 1634 procedure MakeUnitInfo(p: integer; const u: TUn; var ui: TUnitInfo); 1635 procedure MakeModelInfo(p, mix: integer; const m: TModel; var mi: TModelInfo); 1636 function IsSameModel(const mi1, mi2: TModelInfo): boolean; 1637 function SpecialTile(Loc, TerrType, lx: integer): integer; 1759 var 1760 DelphiRandSeed: Integer; 1761 1762 procedure MakeUnitInfo(p: Integer; const u: TUn; var ui: TUnitInfo); 1763 procedure MakeModelInfo(p, mix: Integer; const m: TModel; var mi: TModelInfo); 1764 function IsSameModel(const mi1, mi2: TModelInfo): Boolean; 1765 function SpecialTile(Loc, TerrType, lx: Integer): Integer; 1766 function DelphiRandom(const pi_Max: Integer): Integer; overload; 1767 function DelphiRandom: Extended; overload; 1768 procedure DelphiRandomize; 1638 1769 1639 1770 implementation 1640 1771 1641 procedure MakeUnitInfo(p: integer; const u: TUn; var ui: TUnitInfo);1772 procedure MakeUnitInfo(p: Integer; const u: TUn; var ui: TUnitInfo); 1642 1773 begin 1643 1774 ui.Owner := p; … … 1652 1783 end; 1653 1784 1654 procedure MakeModelInfo(p, mix: integer; const m: TModel; var mi: TModelInfo);1785 procedure MakeModelInfo(p, mix: Integer; const m: TModel; var mi: TModelInfo); 1655 1786 var 1656 i: integer;1787 i: Integer; 1657 1788 begin 1658 1789 mi.Owner := p; … … 1691 1822 end; 1692 1823 1693 function IsSameModel(const mi1, mi2: TModelInfo): boolean;1824 function IsSameModel(const mi1, mi2: TModelInfo): Boolean; 1694 1825 type 1695 1826 TModelInfo_Compare = array [0 .. 5] of Cardinal; … … 1704 1835 end; 1705 1836 1706 function SpecialTile(Loc, TerrType, lx: integer): integer;1837 function SpecialTile(Loc, TerrType, lx: Integer): Integer; 1707 1838 var 1708 x, y, qx, qy, a: integer;1839 x, y, qx, qy, a: Integer; 1709 1840 begin 1710 1841 if TerrType = fOcean then … … 1752 1883 procedure InitUnit; 1753 1884 begin 1754 { TODO 1755 Assert(sizeof(TPlayerContext) = 2048); 1756 Assert(sizeof(TModel) - 2 * sizeof(LongInt) - 4 * sizeof(word) 1885 Assert(SizeOf(TPlayerContext) = 1936 + 28 * SizeOf(Pointer)); 1886 Assert(SizeOf(TModel) - 2 * SizeOf(LongInt) - 4 * SizeOf(Word) 1757 1887 = sIntSetDevModel and $F * 4); 1758 }1759 1888 end; 1760 1889 1890 function DelphiRandom(const pi_Max: Integer): Integer; 1891 var 1892 Temp: LongInt; 1893 begin 1894 Temp := LongInt(Int64(134775813) * Int64(DelphiRandSeed) + 1); 1895 DelphiRandSeed := LongInt(Temp); 1896 Result := (UInt64(Cardinal(pi_Max)) * UInt64(Cardinal(Temp))) shr 32; 1897 end; 1898 1899 function DelphiRandom: Extended; overload; 1900 begin 1901 Result := DelphiRandom(High(LongInt)) / High(LongInt); 1902 end; 1903 1904 procedure DelphiRandomize; 1905 begin 1906 Randomize; 1907 DelphiRandSeed := RandSeed; 1908 end; 1909 1761 1910 initialization 1762 1911 -
branches/highdpi/AI/StdAI/StdAI.lpi
r160 r303 2 2 <CONFIG> 3 3 <ProjectOptions> 4 <Version Value="1 0"/>4 <Version Value="11"/> 5 5 <PathDelim Value="\"/> 6 6 <General> … … 68 68 </PublishOptions> 69 69 <RunParams> 70 <local> 71 <FormatVersion Value="1"/> 72 </local> 70 <FormatVersion Value="2"/> 71 <Modes Count="0"/> 73 72 </RunParams> 74 73 <RequiredPackages Count="1"> … … 77 76 </Item1> 78 77 </RequiredPackages> 79 <Units Count=" 7">78 <Units Count="8"> 80 79 <Unit0> 81 80 <Filename Value="StdAI.lpr"/> … … 106 105 <IsPartOfProject Value="True"/> 107 106 </Unit6> 107 <Unit7> 108 <Filename Value="Barbarina.pas"/> 109 <IsPartOfProject Value="True"/> 110 </Unit7> 108 111 </Units> 109 112 </ProjectOptions> -
branches/highdpi/AI/StdAI/StdAI.lpr
r210 r303 3 3 4 4 uses 5 {$IFDEF DEBUG}Names in 'Names.pas',{$ENDIF}5 {$IFDEF DEBUG}Names in 'Names.pas', {$ENDIF} 6 6 Protocol in 'Protocol.pas', 7 7 CustomAI in 'CustomAI.pas', … … 11 11 12 12 var 13 AIList: array[0..nPl-1] of TCustomAI;14 Defender: integer;13 AIList: array[0..nPl - 1] of TCustomAI; 14 Defender: integer; 15 15 16 16 17 procedure Client(Command,Player:integer;var Data); stdcall; 18 var 19 p,y0,ToLoc: integer; 20 UnitInfo: TUnitInfo; 21 begin 22 case Command of 23 cInitModule: 24 begin 25 Server:=TInitModuleData(Data).Server; 26 TInitModuleData(Data).DataSize:=RWDataSize; 17 procedure Client(Command, Player: integer; var Data); stdcall; 18 var 19 p, y0, ToLoc: integer; 20 UnitInfo: TUnitInfo; 21 begin 22 case Command of 23 cInitModule: 24 begin 25 Server := TInitModuleData(Data).Server; 26 TInitModuleData(Data).DataSize := RWDataSize; 27 end; 28 cNewGame, cLoadGame: 29 begin 30 {$IFNDEF DEBUG} 31 Randomize; 32 {$ENDIF} 33 CustomAI.Init(TNewGameData(Data)); 34 for p := nPl - 1 downto 0 do 35 if G.RO[p] <> nil then 36 begin 37 AIList[p] := TAI.Create(p); 38 AIList[p].SetDataDefaults; 39 end 40 else 41 AIList[p] := nil; 42 Defender := -1; 43 end; 44 cGetReady: 45 for p := nPl - 1 downto 0 do 46 if AIList[p] <> nil then 47 AIList[p].SetDataRandom; 48 cBreakGame: 49 for p := 0 to nPl - 1 do 50 if AIList[p] <> nil then 51 AIList[p].Free; 52 53 cTurn, cContinue, scContact..scDipBreak, cShowEndContact: 54 AIList[Player].Process(Command, Data); 55 56 cShowAttacking, cShowCapturing: 57 with TShowMove(Data) do 58 begin 59 y0 := FromLoc div G.lx; 60 ToLoc := (FromLoc + (dx + y0 and 1 + G.lx + G.lx) shr 1) mod 61 G.lx + G.lx * (y0 + dy); 62 if G.RO[Player].Map[ToLoc] and fOwned <> 0 then 63 begin 64 UnitInfo.Loc := FromLoc; 65 UnitInfo.mix := mix; 66 UnitInfo.emix := emix; 67 UnitInfo.Owner := Owner; 68 UnitInfo.Health := Health; 69 UnitInfo.Fuel := Fuel; 70 UnitInfo.Job := jNone; 71 UnitInfo.Exp := Exp; 72 UnitInfo.Load := Load; 73 UnitInfo.Flags := Flags; 74 if Command = cShowAttacking then 75 AIList[Player].OnBeforeEnemyAttack(UnitInfo, ToLoc, EndHealth, 76 EndHealthDef) 77 else 78 AIList[Player].OnBeforeEnemyCapture(UnitInfo, ToLoc); 79 Defender := Player; 80 end; 81 end; 82 cShowAfterAttack: 83 if Player = Defender then 84 begin 85 AIList[Player].OnAfterEnemyAttack; 86 Defender := -1; 87 end; 88 cShowAfterMove: 89 if Player = Defender then 90 begin 91 AIList[Player].OnAfterEnemyCapture; 92 Defender := -1; 93 end; 94 95 else {ignore other commands} 27 96 end; 28 cNewGame,cLoadGame: 29 begin 30 {$IFNDEF DEBUG}Randomize;{$ENDIF} 31 CustomAI.Init(TNewGameData(Data)); 32 for p:=nPl-1 downto 0 do 33 if G.RO[p]<>nil then 34 begin 35 AIList[p]:=TAI.Create(p); 36 AIList[p].SetDataDefaults; 37 end 38 else AIList[p]:=nil; 39 Defender:=-1; 40 end; 41 cGetReady: 42 for p:=nPl-1 downto 0 do 43 if AIList[p]<>nil then AIList[p].SetDataRandom; 44 cBreakGame: 45 for p:=0 to nPl-1 do 46 if AIList[p]<>nil then AIList[p].Free; 47 48 cTurn, cContinue, scContact..scDipBreak, cShowEndContact: 49 AIList[Player].Process(Command, Data); 50 51 cShowAttacking, cShowCapturing: 52 with TShowMove(Data) do 53 begin 54 y0:=FromLoc div G.lx; 55 ToLoc:=(FromLoc+(dx+y0 and 1+G.lx+G.lx) shr 1) mod G.lx +G.lx*(y0+dy); 56 if G.RO[Player].Map[ToLoc] and fOwned<>0 then 57 begin 58 UnitInfo.Loc:=FromLoc; 59 UnitInfo.mix:=mix; 60 UnitInfo.emix:=emix; 61 UnitInfo.Owner:=Owner; 62 UnitInfo.Health:=Health; 63 UnitInfo.Fuel:=Fuel; 64 UnitInfo.Job:=jNone; 65 UnitInfo.Exp:=Exp; 66 UnitInfo.Load:=Load; 67 UnitInfo.Flags:=Flags; 68 if Command=cShowAttacking then 69 AIList[Player].OnBeforeEnemyAttack(UnitInfo, ToLoc, EndHealth, 70 EndHealthDef) 71 else AIList[Player].OnBeforeEnemyCapture(UnitInfo, ToLoc); 72 Defender:=Player 73 end 74 end; 75 cShowAfterAttack: 76 if Player=Defender then 77 begin 78 AIList[Player].OnAfterEnemyAttack; 79 Defender:=-1; 80 end; 81 cShowAfterMove: 82 if Player=Defender then 83 begin 84 AIList[Player].OnAfterEnemyCapture; 85 Defender:=-1; 86 end; 87 88 else {ignore other commands} 89 end 90 end; 97 end; 91 98 92 99 exports 93 Client Name 'client';100 Client Name 'client'; 94 101 95 102 end. 96 97 98 -
branches/highdpi/AI/StdAI/ToolAI.pas
r210 r303 5 5 6 6 uses 7 {$IFDEF DEBUG}SysUtils,{$ENDIF} // necessary for debug exceptions 8 Math, 7 SysUtils, Math, 9 8 {$IFDEF DEBUG}Names,{$ENDIF} 10 Protocol, CustomAI; 11 9 Protocol, CustomAI; 12 10 13 11 type 14 TGroupTransportPlan=record15 LoadLoc, uixTransport, nLoad, TurnsEmpty, TurnsLoaded: integer;16 uixLoad: array[0..15] of integer;17 end; 18 19 20 TToolAI = class(TCustomAI)21 protected22 {$IFDEF DEBUG}DebugMap: array[0..lxmax *lymax-1] of integer;{$ENDIF}23 24 function CenterOfEmpire: integer;12 TGroupTransportPlan = record 13 LoadLoc, uixTransport, nLoad, TurnsEmpty, TurnsLoaded: integer; 14 uixLoad: array[0..15] of integer; 15 end; 16 17 18 TToolAI = class(TCustomAI) 19 protected 20 {$IFDEF DEBUG}DebugMap: array[0..lxmax * lymax - 1] of integer;{$ENDIF} 21 22 function CenterOfEmpire: integer; 25 23 // tile that is in the middle of all own cities 26 24 27 function CityTaxBalance(cix: integer; const CityReport: TCityReport): integer;25 function CityTaxBalance(cix: integer; const CityReport: TCityReport): integer; 28 26 // calculates exact difference of income and maintenance cost for a single city 29 27 // positive result = income higher than maintenance … … 31 29 // respects production and food converted to gold 32 30 // CityReport must have been prepared before 33 procedure SumCities(TaxRate: integer; var TaxSum, ScienceSum: integer);31 procedure SumCities(TaxRate: integer; var TaxSum, ScienceSum: integer); 34 32 // calculates exact total tax and science income 35 33 // tax is reduced by maintenance (so might be negative) 36 34 // luxury not supported 37 35 38 procedure OptimizeCityTiles;36 procedure OptimizeCityTiles; 39 37 // obsolete; use City_OptimizeTiles instead 40 38 41 procedure GetCityProdPotential;39 procedure GetCityProdPotential; 42 40 // calculates potential collected production resources of a city 43 41 // result: list for all cities in CityResult 44 procedure GetCityTradePotential;42 procedure GetCityTradePotential; 45 43 // calculates potential collected trade resources of a city 46 44 // result: list for all cities in CityResult 47 45 48 procedure JobAssignment_Initialize;46 procedure JobAssignment_Initialize; 49 47 // initialization, must be called first of the JobAssignment functions 50 procedure JobAssignment_AddJob(Loc, Job, Score: integer);48 procedure JobAssignment_AddJob(Loc, Job, Score: integer); 51 49 // add job for settlers with certain score 52 50 // jobs include founding cities! 53 procedure JobAssignment_AddUnit(uix: integer);51 procedure JobAssignment_AddUnit(uix: integer); 54 52 // add a settler unit to do jobs 55 procedure JobAssignment_Go;53 procedure JobAssignment_Go; 56 54 // to be called after all jobs and the settlers for them have been added 57 55 // assigns each job to one settler, moves the settlers and makes them work … … 59 57 // starting a job one turn earlier counts the same as 4 points of score 60 58 // function does not cancel jobs that are already started 61 function JobAssignment_GotJob(uix: integer): boolean;59 function JobAssignment_GotJob(uix: integer): boolean; 62 60 // can be called after JobAssignment_Go to find out whether 63 61 // a certain settler has been assigned a job to 64 62 65 procedure AnalyzeMap;63 procedure AnalyzeMap; 66 64 // calculates formations and districts 67 65 68 function CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: integer; 69 var TimeAfterStep, RecoverTurns: integer; FromTile, ToTile: integer; IsCapture: boolean): integer; 66 function CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: integer; 67 var TimeAfterStep, RecoverTurns: integer; FromTile, ToTile: integer; 68 IsCapture: boolean): integer; 70 69 // forecast single unit move between adjacent tiles 71 70 // format of TimeBeforeStep and TimeAfterStep: $1000*number of turns + $800-MP left … … 75 74 // CrossCorner=1 for long moves that cross the tile corner, =0 for short ones that don't 76 75 77 function GetMyMoveStyle(mix,Health: integer): integer;78 79 function Unit_MoveEx(uix,ToLoc: integer; Options: integer = 0): integer;80 81 procedure SeaTransport_BeginInitialize;82 procedure SeaTransport_EndInitialize;76 function GetMyMoveStyle(mix, Health: integer): integer; 77 78 function Unit_MoveEx(uix, ToLoc: integer; Options: integer = 0): integer; 79 80 procedure SeaTransport_BeginInitialize; 81 procedure SeaTransport_EndInitialize; 83 82 // sea transport, obligatory call order: 84 83 // 1. BeginInitialize … … 91 90 // - all transports have same capacity 92 91 // - no transport is damaged 93 procedure SeaTransport_AddLoad(uix: integer);94 procedure SeaTransport_AddTransport(uix: integer);95 procedure SeaTransport_AddDestination(Loc: integer);96 function SeaTransport_MakeGroupPlan(var TransportPlan: TGroupTransportPlan): boolean;92 procedure SeaTransport_AddLoad(uix: integer); 93 procedure SeaTransport_AddTransport(uix: integer); 94 procedure SeaTransport_AddDestination(Loc: integer); 95 function SeaTransport_MakeGroupPlan(var TransportPlan: TGroupTransportPlan): boolean; 97 96 // make plan for group of units to transport from a single loading location by a single transport 98 97 // the plan optimizes: … … 104 103 // function returns false if no more transports are possible 105 104 106 function CurrentMStrength(Domain: integer): integer;105 function CurrentMStrength(Domain: integer): integer; 107 106 end; 108 107 109 108 110 109 const 111 // no-formations 112 nfUndiscovered=-1; nfPole=-2; nfPeace=-3; 113 114 // return codes of CheckStep 115 csOk=0; 110 // no-formations 111 nfUndiscovered = -1; 112 nfPole = -2; 113 nfPeace = -3; 114 115 // return codes of CheckStep 116 csOk = 0; 116 117 // step is valid 117 118 // TimeAfterMove has been calculated 118 csForbiddenTile=1;119 csForbiddenTile = 1; 119 120 // unit can not move onto this tile 120 121 // TimeAfterMove not calculated 121 csForbiddenStep=2;122 csForbiddenStep = 2; 122 123 // (ZoC unit only) unit can not do this step because of ZoC violation 123 124 // maybe tile can be reached using another way 124 125 // TimeAfterMove not calculated 125 csCheckTerritory=3;126 csCheckTerritory = 3; 126 127 // move within other nations's territory shortly after making peace 127 128 // step is only possible if RO.Territory is the same for both tiles 128 129 // TimeAfterMove has been calculated 129 130 130 // Unit_MoveEx131 mxAdjacent=$00000001;132 133 134 var 135 nContinent, nOcean, nDistrict: integer;136 Formation: array[0..lxmax*lymax-1] of integer;131 // Unit_MoveEx 132 mxAdjacent = $00000001; 133 134 135 var 136 nContinent, nOcean, nDistrict: integer; 137 Formation: array[0..lxmax * lymax - 1] of integer; 137 138 // water: ocean index, land: continent index, sorted by size 138 139 // territory unpassable due to peace treaty divides a continent 139 District: array[0..lxmax*lymax-1] of integer;140 District: array[0..lxmax * lymax - 1] of integer; 140 141 // index of coherent own territory, sorted by size 141 CityResult: array[0..nCmax-1] of integer; 142 143 Advancedness: array[0..nAdv-1] of integer; // total number of prerequisites for each advance 142 CityResult: array[0..nCmax - 1] of integer; 143 144 Advancedness: array[0..nAdv - 1] of integer; 145 // total number of prerequisites for each advance 144 146 145 147 … … 147 149 148 150 uses 149 Pile;151 Pile; 150 152 151 153 type 152 pinteger=^integer;153 154 var 155 // for JobAssignment156 MaxScore: integer;157 TileJob,TileJobScore: array[0..lxmax*lymax-1] of byte;158 JobLocOfSettler: array[0..nUmax-1] of integer; // ToAssign = find job159 160 // for Transport161 TransportMoveStyle, TransportCapacity, nTransportLoad: integer;162 InitComplete, HaveDestinations: boolean;163 uixTransportLoad, TransportAvailable: array[0..nUmax-1] of integer;164 TurnsAfterLoad: array[0..lxmax*lymax-1] of shortint;165 166 167 procedure ReplaceD(Start, Stop: pinteger; Raider, Twix: integer);168 begin 169 while Start<>Stop do154 pinteger = ^integer; 155 156 var 157 // for JobAssignment 158 MaxScore: integer; 159 TileJob, TileJobScore: array[0..lxmax * lymax - 1] of byte; 160 JobLocOfSettler: array[0..nUmax - 1] of integer; // ToAssign = find job 161 162 // for Transport 163 TransportMoveStyle, TransportCapacity, nTransportLoad: integer; 164 InitComplete, HaveDestinations: boolean; 165 uixTransportLoad, TransportAvailable: array[0..nUmax - 1] of integer; 166 TurnsAfterLoad: array[0..lxmax * lymax - 1] of shortint; 167 168 169 procedure ReplaceD(Start, Stop: pinteger; Raider, Twix: integer); 170 begin 171 while Start <> Stop do 170 172 begin 171 if Start^=Raider then Start^:=Twix; 172 inc(Start) 173 if Start^ = Raider then 174 Start^ := Twix; 175 Inc(Start); 173 176 end; 174 177 end; … … 176 179 function NextZero(Start, Stop: pinteger; Mask: cardinal): pinteger; 177 180 begin 178 while (Start<>Stop) and (Start^ and Mask<>0) do inc(Start); 179 result:=Start; 181 while (Start <> Stop) and (Start^ and Mask <> 0) do 182 Inc(Start); 183 Result := Start; 180 184 end; 181 185 … … 183 187 function TToolAI.CenterOfEmpire: integer; 184 188 var 185 cix,Loc,x,y,sy,n: integer;186 a,su,sv: double;187 begin 188 n:=0;189 sy:=0;190 su:=0;191 sv:=0;192 for cix:=0 to RO.nCity-1 do189 cix, Loc, x, y, sy, n: integer; 190 a, su, sv: double; 191 begin 192 n := 0; 193 sy := 0; 194 su := 0; 195 sv := 0; 196 for cix := 0 to RO.nCity - 1 do 193 197 begin 194 Loc:=MyCity[cix].Loc;195 if Loc>=0 then196 begin 197 y:=Loc div G.lx;198 x:=Loc-y*G.lx;199 inc(sy,y);200 a:=2*pi*x/G.lx;201 su:=su+cos(a);202 sv:=sv+sin(a);203 inc(n);204 end; 205 end; 206 a:=arctan2(sv,su);207 x:=round(G.lx*a/(2*pi));208 while x>=G.lx do209 dec(x,G.lx);210 while x<0 do211 inc(x,G.lx);212 result:=((2*sy+n) div (2*n))*G.lx + x;198 Loc := MyCity[cix].Loc; 199 if Loc >= 0 then 200 begin 201 y := Loc div G.lx; 202 x := Loc - y * G.lx; 203 Inc(sy, y); 204 a := 2 * pi * x / G.lx; 205 su := su + cos(a); 206 sv := sv + sin(a); 207 Inc(n); 208 end; 209 end; 210 a := arctan2(sv, su); 211 x := round(G.lx * a / (2 * pi)); 212 while x >= G.lx do 213 Dec(x, G.lx); 214 while x < 0 do 215 Inc(x, G.lx); 216 Result := ((2 * sy + n) div (2 * n)) * G.lx + x; 213 217 end; 214 218 215 219 function TToolAI.CityTaxBalance(cix: integer; const CityReport: TCityReport): integer; 216 220 var 217 i: integer;218 begin 219 result:=0;220 if (CityReport.Working-CityReport.Happy<=MyCity[cix].Size shr 1) {no disorder} 221 and (MyCity[cix].Flags and chCaptured=0) then // not captured221 i: integer; 222 begin 223 Result := 0; 224 if (CityReport.Working - CityReport.Happy <= MyCity[cix].Size shr 1) {no disorder} and 225 (MyCity[cix].Flags and chCaptured = 0) then // not captured 222 226 begin 223 inc(result, CityReport.Tax);224 if (MyCity[cix].Project and (cpImp+cpIndex)=cpImp+imTrGoods)225 and (CityReport.ProdRep>CityReport.Support) then226 inc(result, CityReport.ProdRep-CityReport.Support);227 if ((RO.Government=gLybertarianism)228 or (MyCity[cix].Size>=NeedAqueductSize)229 and (CityReport.FoodRep<CityReport.Eaten+2))230 and (CityReport.FoodRep>CityReport.Eaten) then231 inc(result, CityReport.FoodRep-CityReport.Eaten);232 end;233 for i:=28 to nImp-1 do if MyCity[cix].Built[i]>0 then234 dec(result, Imp[i].Maint);227 Inc(Result, CityReport.Tax); 228 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) and 229 (CityReport.ProdRep > CityReport.Support) then 230 Inc(Result, CityReport.ProdRep - CityReport.Support); 231 if ((RO.Government = gLybertarianism) or (MyCity[cix].Size >= 232 NeedAqueductSize) and (CityReport.FoodRep < CityReport.Eaten + 2)) and 233 (CityReport.FoodRep > CityReport.Eaten) then 234 Inc(Result, CityReport.FoodRep - CityReport.Eaten); 235 end; 236 for i := 28 to nImp - 1 do 237 if MyCity[cix].Built[i] > 0 then 238 Dec(Result, Imp[i].Maint); 235 239 end; 236 240 237 241 procedure TToolAI.SumCities(TaxRate: integer; var TaxSum, ScienceSum: integer); 238 242 var 239 cix,p1: integer; 240 CityReport: TCityReport; 241 begin 242 TaxSum:=0; ScienceSum:=0; 243 if RO.Government=gAnarchy then exit; 244 for p1:=0 to nPl-1 do 245 if RO.Tribute[p1]<=RO.TributePaid[p1] then // don't rely on tribute from bankrupt nations 246 TaxSum:=TaxSum+RO.Tribute[p1]; 247 for cix:=0 to RO.nCity-1 do if MyCity[cix].Loc>=0 then 248 begin 249 City_GetHypoReport(cix,-1,TaxRate,0,CityReport); 250 if (CityReport.Working-CityReport.Happy<=MyCity[cix].Size shr 1) {no disorder} 251 and (MyCity[cix].Flags and chCaptured=0) then // not captured 252 ScienceSum:=ScienceSum+CityReport.Science; 253 TaxSum:=TaxSum+CityTaxBalance(cix, CityReport); 254 end; 243 cix, p1: integer; 244 CityReport: TCityReport; 245 begin 246 TaxSum := 0; 247 ScienceSum := 0; 248 if RO.Government = gAnarchy then 249 exit; 250 for p1 := 0 to nPl - 1 do 251 if RO.Tribute[p1] <= RO.TributePaid[p1] then 252 // don't rely on tribute from bankrupt nations 253 TaxSum := TaxSum + RO.Tribute[p1]; 254 for cix := 0 to RO.nCity - 1 do 255 if MyCity[cix].Loc >= 0 then 256 begin 257 City_GetHypoReport(cix, -1, TaxRate, 0, CityReport); 258 if (CityReport.Working - CityReport.Happy <= MyCity[cix].Size shr 259 1) {no disorder} and (MyCity[cix].Flags and chCaptured = 0) then // not captured 260 ScienceSum := ScienceSum + CityReport.Science; 261 TaxSum := TaxSum + CityTaxBalance(cix, CityReport); 262 end; 255 263 end; 256 264 … … 260 268 261 269 const 262 pctOptimize=0; pctGetProdPotential=1; pctGetTradePotential=2; 270 pctOptimize = 0; 271 pctGetProdPotential = 1; 272 pctGetTradePotential = 2; 263 273 264 274 procedure TToolAI.OptimizeCityTiles; 265 275 var 266 cix: integer; 267 begin 268 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 269 City_OptimizeTiles(cix); 276 cix: integer; 277 begin 278 for cix := 0 to RO.nCity - 1 do 279 with MyCity[cix] do 280 if Loc >= 0 then 281 City_OptimizeTiles(cix); 270 282 end; 271 283 272 284 procedure TToolAI.GetCityProdPotential; 273 285 var 274 cix: integer; 275 Advice: TCityTileAdviceData; 276 begin 277 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 278 begin 279 Advice.ResourceWeights:=rwMaxProd; 280 Server(sGetCityTileAdvice, me, cix, Advice); 281 CityResult[cix]:=Advice.CityReport.ProdRep; // considers factory, but shouldn't 282 end; 286 cix: integer; 287 Advice: TCityTileAdviceData; 288 begin 289 for cix := 0 to RO.nCity - 1 do 290 with MyCity[cix] do 291 if Loc >= 0 then 292 begin 293 Advice.ResourceWeights := rwMaxProd; 294 Server(sGetCityTileAdvice, me, cix, Advice); 295 CityResult[cix] := Advice.CityReport.ProdRep; // considers factory, but shouldn't 296 end; 283 297 end; 284 298 285 299 procedure TToolAI.GetCityTradePotential; 286 300 var 287 cix: integer; 288 Advice: TCityTileAdviceData; 289 begin 290 for cix:=0 to RO.nCity-1 do with MyCity[cix] do if Loc>=0 then 291 begin 292 Advice.ResourceWeights:=rwMaxScience; 293 Server(sGetCityTileAdvice, me, cix, Advice); 294 CityResult[cix]:=Advice.CityReport.Trade; 295 end; 301 cix: integer; 302 Advice: TCityTileAdviceData; 303 begin 304 for cix := 0 to RO.nCity - 1 do 305 with MyCity[cix] do 306 if Loc >= 0 then 307 begin 308 Advice.ResourceWeights := rwMaxScience; 309 Server(sGetCityTileAdvice, me, cix, Advice); 310 CityResult[cix] := Advice.CityReport.Trade; 311 end; 296 312 end; 297 313 … … 301 317 302 318 const 303 ToAssign=lxmax*lymax;319 ToAssign = lxmax * lymax; 304 320 305 321 procedure TToolAI.JobAssignment_Initialize; 306 322 begin 307 fillchar(JobLocOfSettler, RO.nUn*sizeof(integer), $FF); // -1308 fillchar(TileJob, MapSize, jNone);309 fillchar(TileJobScore, MapSize, 0);310 MaxScore:=0;323 fillchar(JobLocOfSettler, RO.nUn * sizeof(integer), $FF); // -1 324 fillchar(TileJob, MapSize, jNone); 325 fillchar(TileJobScore, MapSize, 0); 326 MaxScore := 0; 311 327 end; 312 328 313 329 procedure TToolAI.JobAssignment_AddJob(Loc, Job, Score: integer); 314 330 begin 315 if Score>255 then Score:=255; 316 if Score>TileJobScore[Loc] then 331 if Score > 255 then 332 Score := 255; 333 if Score > TileJobScore[Loc] then 317 334 begin 318 TileJob[Loc]:=Job; 319 TileJobScore[Loc]:=Score; 320 if Score>MaxScore then MaxScore:=Score 335 TileJob[Loc] := Job; 336 TileJobScore[Loc] := Score; 337 if Score > MaxScore then 338 MaxScore := Score; 321 339 end; 322 340 end; … … 324 342 procedure TToolAI.JobAssignment_AddUnit(uix: integer); 325 343 begin 326 assert(MyModel[MyUnit[uix].mix].Kind in [mkSettler,mkSlaves]);327 JobLocOfSettler[uix]:=ToAssign 344 assert(MyModel[MyUnit[uix].mix].Kind in [mkSettler, mkSlaves]); 345 JobLocOfSettler[uix] := ToAssign; 328 346 end; 329 347 330 348 function TToolAI.JobAssignment_GotJob(uix: integer): boolean; 331 349 begin 332 result:=JobLocOfSettler[uix]>=0;350 Result := JobLocOfSettler[uix] >= 0; 333 351 end; 334 352 335 353 procedure TToolAI.JobAssignment_Go; 336 354 const 337 DistanceScore=4;338 StepSizeByTerrain: array[0..11] of integer=339 (0, 0, 1, 2, 1, 1, 0, 1, 0, 1, 1, 2);340 //Oc-Sh-Gr-De-Pr-Tu-Ar-Sw-XX-Fo-Hi-Mo341 var 342 uix,BestScore,BestCount,BestLoc,BestJob,BestDistance,TestLoc,NextLoc,343 TestDistance,V8,TestScore,StepSize,MoveResult: integer;344 UnitsToAssign: boolean;345 Adjacent: TVicinity8Loc;346 SettlerOfJobLoc,DistToLoc: array[0..lxmax*lymax-1] of smallint;355 DistanceScore = 4; 356 StepSizeByTerrain: array[0..11] of integer = 357 (0, 0, 1, 2, 1, 1, 0, 1, 0, 1, 1, 2); 358 //Oc-Sh-Gr-De-Pr-Tu-Ar-Sw-XX-Fo-Hi-Mo 359 var 360 uix, BestScore, BestCount, BestLoc, BestJob, BestDistance, TestLoc, 361 NextLoc, TestDistance, V8, TestScore, StepSize, MoveResult: integer; 362 UnitsToAssign: boolean; 363 Adjacent: TVicinity8Loc; 364 SettlerOfJobLoc, DistToLoc: array[0..lxmax * lymax - 1] of smallint; 347 365 // DistToLoc is only defined where SettlerOfJobLoc>=0 348 TileChecked: array[0..lxmax*lymax-1] of boolean;349 begin 350 fillchar(SettlerOfJobLoc, MapSize*2, $FF); // -1351 352 // keep up jobs that are already started353 for uix:=0 to RO.nUn-1 do354 if (MyUnit[uix].Loc>=0) and (MyUnit[uix].Job>jNone) then355 begin 356 JobLocOfSettler[uix]:=MyUnit[uix].Loc;357 SettlerOfJobLoc[MyUnit[uix].Loc]:=uix;358 DistToLoc[MyUnit[uix].Loc]:=0359 end; 360 361 // assign remaining jobs to remaining settlers362 UnitsToAssign:=true;363 while UnitsToAssign do366 TileChecked: array[0..lxmax * lymax - 1] of boolean; 367 begin 368 fillchar(SettlerOfJobLoc, MapSize * 2, $FF); // -1 369 370 // keep up jobs that are already started 371 for uix := 0 to RO.nUn - 1 do 372 if (MyUnit[uix].Loc >= 0) and (MyUnit[uix].Job > jNone) then 373 begin 374 JobLocOfSettler[uix] := MyUnit[uix].Loc; 375 SettlerOfJobLoc[MyUnit[uix].Loc] := uix; 376 DistToLoc[MyUnit[uix].Loc] := 0; 377 end; 378 379 // assign remaining jobs to remaining settlers 380 UnitsToAssign := True; 381 while UnitsToAssign do 364 382 begin 365 UnitsToAssign:=false; 366 for uix:=0 to RO.nUn-1 do if JobLocOfSettler[uix]=ToAssign then 367 begin 368 BestJob:=jNone; 369 BestScore:=-999999; 370 FillChar(TileChecked,MapSize*sizeof(boolean),false); 371 Pile.Create(MapSize); 372 Pile.Put(MyUnit[uix].Loc,0); // start search for new job at current location 373 while Pile.Get(TestLoc,TestDistance) do 374 begin 375 // add surrounding tiles to queue, but only if there's a chance to beat BestScore 376 if MaxScore-DistanceScore*(TestDistance+1)>=BestScore then 383 UnitsToAssign := False; 384 for uix := 0 to RO.nUn - 1 do 385 if JobLocOfSettler[uix] = ToAssign then 386 begin 387 BestJob := jNone; 388 BestScore := -999999; 389 FillChar(TileChecked, MapSize * sizeof(boolean), False); 390 Pile.Create(MapSize); 391 Pile.Put(MyUnit[uix].Loc, 0); // start search for new job at current location 392 while Pile.Get(TestLoc, TestDistance) do 377 393 begin 378 V8_to_Loc(TestLoc,Adjacent);379 for V8:=0 to 7 do394 // add surrounding tiles to queue, but only if there's a chance to beat BestScore 395 if MaxScore - DistanceScore * (TestDistance + 1) >= BestScore then 380 396 begin 381 NextLoc:=Adjacent[V8]; 382 if (NextLoc>=0) and not TileChecked[NextLoc] 383 and (Map[NextLoc] and fTerrain<>fUNKNOWN) then 397 V8_to_Loc(TestLoc, Adjacent); 398 for V8 := 0 to 7 do 384 399 begin 385 StepSize:=StepSizeByTerrain[Map[NextLoc] and fTerrain]; 386 if (StepSize>0) // no water or arctic tile 387 and (Map[NextLoc] and (fUnit or fOwned)<>fUnit) // no foreign unit 388 and ((RO.Territory[NextLoc]<0) or (RO.Territory[NextLoc]=me)) // no foreign territory 389 and (Map[TestLoc] and Map[NextLoc] and fInEnemyZoC=0) then // move not prevented by ZoC 390 Pile.Put(NextLoc,TestDistance+StepSize) 391 // simplification, only optimal for 150 mp units in land with no roads 400 NextLoc := Adjacent[V8]; 401 if (NextLoc >= 0) and not TileChecked[NextLoc] and 402 (Map[NextLoc] and fTerrain <> fUNKNOWN) then 403 begin 404 StepSize := StepSizeByTerrain[Map[NextLoc] and fTerrain]; 405 if (StepSize > 0) // no water or arctic tile 406 and (Map[NextLoc] and (fUnit or fOwned) <> fUnit) // no foreign unit 407 and ((RO.Territory[NextLoc] < 0) or 408 (RO.Territory[NextLoc] = me)) // no foreign territory 409 and (Map[TestLoc] and Map[NextLoc] and fInEnemyZoC = 0) then 410 // move not prevented by ZoC 411 Pile.Put(NextLoc, TestDistance + StepSize); 412 // simplification, only optimal for 150 mp units in land with no roads 413 end; 414 end; 415 end; 416 417 // check tile for job 418 if (TileJob[TestLoc] > jNone) and 419 ((MyModel[MyUnit[uix].mix].Kind <> mkSlaves) or 420 (TileJob[TestLoc] <> jCity)) and 421 ((SettlerOfJobLoc[TestLoc] < 0) or (DistToLoc[TestLoc] > TestDistance)) then 422 begin 423 TestScore := integer(TileJobScore[TestLoc]) - DistanceScore * TestDistance; 424 if TestScore > BestScore then 425 BestCount := 0; 426 if TestScore >= BestScore then 427 begin 428 Inc(BestCount); 429 if random(BestCount) = 0 then 430 begin 431 BestScore := TestScore; 432 BestLoc := TestLoc; 433 BestJob := TileJob[TestLoc]; 434 BestDistance := TestDistance; 435 end; 436 end; 437 end; 438 TileChecked[TestLoc] := True; 439 end; 440 Pile.Free; 441 442 if BestJob > jNone then 443 begin // new job found for this unit 444 if SettlerOfJobLoc[BestLoc] >= 0 then 445 begin // another unit was already assigned to this job, but is not as close -- reassign that unit! 446 JobLocOfSettler[SettlerOfJobLoc[BestLoc]] := ToAssign; 447 UnitsToAssign := True; 448 end; 449 JobLocOfSettler[uix] := BestLoc; 450 SettlerOfJobLoc[BestLoc] := uix; 451 DistToLoc[BestLoc] := BestDistance; 452 end 453 else 454 JobLocOfSettler[uix] := -1; // no jobs for this settler 455 end; // for uix 456 end; 457 458 // move settlers and start new jobs 459 for uix := 0 to RO.nUn - 1 do 460 with MyUnit[uix] do 461 if (Loc >= 0) and (Job = jNone) and (JobLocOfSettler[uix] >= 0) then 462 begin 463 if Loc <> JobLocOfSettler[uix] then 464 repeat 465 MoveResult := Unit_Move(uix, JobLocOfSettler[uix]) 466 until (MoveResult < rExecuted) or (MoveResult and 467 (rLocationReached or rMoreTurns or rUnitRemoved) <> 0); 468 if (Loc = JobLocOfSettler[uix]) and (Movement >= 100) then 469 Unit_StartJob(uix, TileJob[JobLocOfSettler[uix]]); 470 end; 471 end; // JobAssignment_Go 472 473 474 //------------------------------------------------------------------------------ 475 // Map Analysis 476 477 procedure TToolAI.AnalyzeMap; 478 var 479 i, j, Loc, Loc1, V8, Count, Kind, MostIndex: integer; 480 Adjacent: TVicinity8Loc; 481 IndexOfID: array[0..lxmax * lymax - 1] of smallint; 482 IDOfIndex: array[0..lxmax * lymax div 2 - 1] of smallint; 483 begin 484 fillchar(District, MapSize * 4, $FF); 485 for Loc := 0 to MapSize - 1 do 486 if Map[Loc] and fTerrain = fUNKNOWN then 487 Formation[Loc] := nfUndiscovered 488 else if Map[Loc] and fTerrain = fArctic then 489 Formation[Loc] := nfPole 490 else if Map[Loc] and fPeace <> 0 then 491 Formation[Loc] := nfPeace 492 else 493 begin 494 Formation[Loc] := Loc; 495 V8_to_Loc(Loc, Adjacent); 496 for V8 := 0 to 7 do 497 begin 498 Loc1 := Adjacent[V8]; 499 if (Loc1 < Loc) and (Loc1 >= 0) and (Formation[Loc1] >= 0) and 500 ((Map[Loc1] and fTerrain >= fGrass) = (Map[Loc] and fTerrain >= fGrass)) then 501 if Formation[Loc] = Loc then 502 Formation[Loc] := Formation[Loc1] 503 else if Formation[Loc] < Formation[Loc1] then 504 ReplaceD(@Formation[Formation[Loc1]], @Formation[Loc + 1], 505 Formation[Loc1], Formation[Loc]) 506 else if Formation[Loc] > Formation[Loc1] then 507 ReplaceD(@Formation[Formation[Loc]], @Formation[Loc + 1], 508 Formation[Loc], Formation[Loc1]); 509 end; 510 if (RO.Territory[Loc] = me) and (Map[Loc] and fTerrain >= fGrass) then 511 begin 512 District[Loc] := Loc; 513 for V8 := 0 to 7 do 514 begin 515 Loc1 := Adjacent[V8]; 516 if (Loc1 < Loc) and (Loc1 >= 0) and (District[Loc1] >= 0) then 517 if District[Loc] = Loc then 518 District[Loc] := District[Loc1] 519 else if District[Loc] < District[Loc1] then 520 ReplaceD(@District[District[Loc1]], @District[Loc + 1], 521 District[Loc1], District[Loc]) 522 else if District[Loc] > District[Loc1] then 523 ReplaceD(@District[District[Loc]], @District[Loc + 1], 524 District[Loc], District[Loc1]); 525 end; 526 end; 527 end; 528 529 // sort continents, oceans and districts by size 530 for Kind := 0 to 2 do 531 begin 532 FillChar(IndexOfID, MapSize * 2, 0); 533 case Kind of 534 0: // continents 535 for Loc := 0 to MapSize - 1 do 536 if (Formation[Loc] >= 0) and (Map[Loc] and fTerrain >= fGrass) then 537 Inc(IndexOfID[Formation[Loc]]); 538 1: // oceans 539 for Loc := 0 to MapSize - 1 do 540 if (Formation[Loc] >= 0) and (Map[Loc] and fTerrain < fGrass) then 541 Inc(IndexOfID[Formation[Loc]]); 542 2: // districts 543 for Loc := 0 to MapSize - 1 do 544 if District[Loc] >= 0 then 545 Inc(IndexOfID[District[Loc]]); 546 end; 547 548 Count := 0; 549 for Loc := 0 to MapSize - 1 do 550 if IndexOfID[Loc] > 0 then 551 begin 552 IDOfIndex[Count] := Loc; 553 Inc(Count); 554 end; 555 for i := 0 to Count - 2 do 556 begin 557 MostIndex := i; 558 for j := i + 1 to Count - 1 do 559 if IndexOfID[IDOfIndex[j]] > IndexOfID[IDOfIndex[MostIndex]] then 560 MostIndex := j; 561 if MostIndex <> i then 562 begin 563 j := IDOfIndex[i]; 564 IDOfIndex[i] := IDOfIndex[MostIndex]; 565 IDOfIndex[MostIndex] := j; 566 end; 567 end; 568 for i := 0 to Count - 1 do 569 IndexOfID[IDOfIndex[i]] := i; 570 571 case Kind of 572 0: // continents 573 begin 574 nContinent := Count; 575 for Loc := 0 to MapSize - 1 do 576 if (Formation[Loc] >= 0) and (Map[Loc] and fTerrain >= fGrass) then 577 Formation[Loc] := IndexOfID[Formation[Loc]]; 578 end; 579 1: // oceans 580 begin 581 nOcean := Count; 582 for Loc := 0 to MapSize - 1 do 583 if (Formation[Loc] >= 0) and (Map[Loc] and fTerrain < fGrass) then 584 Formation[Loc] := IndexOfID[Formation[Loc]]; 585 end; 586 2: // districts 587 begin 588 nDistrict := Count; 589 for Loc := 0 to MapSize - 1 do 590 if District[Loc] >= 0 then 591 District[Loc] := IndexOfID[District[Loc]]; 592 end; 593 end; 594 end; 595 end; 596 597 598 //------------------------------------------------------------------------------ 599 // Path Finding 600 601 const 602 // basic move styles 603 msGround = $00000000; 604 msNoGround = $10000000; 605 msAlpine = $20000000; 606 msOver = $40000000; 607 msSpy = $50000000; 608 609 // other 610 msHostile = $08000000; 611 612 // bits: |31|30|29|28|27|26 .. 16|15|14|13|12|11|10| 9| 8| 7| 6| 5| 4| 3| 2| 1| 0| 613 // ground: | Basic |Ho| Speed | HeavyCost | RailCost | 614 // other: | Basic | 0| Speed | X X X | MaxTerrType | 615 616 function TToolAI.GetMyMoveStyle(mix, Health: integer): integer; 617 begin 618 with MyModel[mix] do 619 begin 620 Result := Speed shl 16; 621 case Domain of 622 dGround: 623 begin 624 Inc(Result, (50 + (Speed - 150) * 13 shr 7) shl 8); //HeavyCost 625 if RO.Wonder[woShinkansen].EffectiveOwner <> me then 626 Inc(Result, Speed * (4 * 1311) shr 17); // RailCost 627 if (RO.Wonder[woGardens].EffectiveOwner <> me) or 628 (Kind = mkSettler) and (Speed >= 200) then 629 Inc(Result, msHostile); 630 if Kind = mkDiplomat then 631 Inc(Result, msSpy) 632 else if Cap[mcOver] > 0 then 633 Inc(Result, msOver) 634 else if Cap[mcAlpine] > 0 then 635 Inc(Result, msAlpine) 636 else 637 Inc(Result, msGround); 638 end; 639 dSea: 640 begin 641 Result := Speed; 642 if RO.Wonder[woMagellan].EffectiveOwner = me then 643 Inc(Result, 200); 644 if Health < 100 then 645 Result := ((Result - 250) * Health div 5000) * 50 + 250; 646 Result := Result shl 16; 647 Inc(Result, msNoGround); 648 if Cap[mcNav] > 0 then 649 Inc(Result); 650 end; 651 dAir: 652 Inc(Result, msNoGround + fUNKNOWN xor 1 - 1); 653 end; 654 end; 655 end; 656 657 function TToolAI.CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: integer; 658 var TimeAfterStep, RecoverTurns: integer; FromTile, ToTile: integer; 659 IsCapture: boolean): integer; 660 var 661 MoveCost, RecoverCost: integer; 662 begin 663 //IsCapture:=true; 664 assert(((FromTile and fTerrain <= fMountains) or (FromTile and 665 fTerrain = fUNKNOWN)) and ((ToTile and fTerrain <= fMountains) or 666 (ToTile and fTerrain = fUNKNOWN))); 667 // do not pass location codes for FromTile and ToTile! 668 RecoverTurns := 0; 669 if MoveStyle < msGround + $10000000 then 670 begin // common ground units 671 if (ToTile + 1) and fTerrain < fGrass + 1 then 672 Result := csForbiddenTile 673 else if (ToTile and not FromTile and fPeace = 0) and 674 (ToTile and (fUnit or fOwned) <> fUnit) and 675 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then 676 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or 677 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then 678 begin // ZoC is ok 679 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then 680 begin // no railroad 681 if (ToTile and (fRoad or fRR or fCity) <> 0) and 682 (FromTile and (fRoad or fRR or fCity) <> 0) or 683 (FromTile and ToTile and (fRiver or fCanal) <> 0) then 684 MoveCost := 20 //move along road, river or canal 685 else 686 begin 687 case Terrain[ToTile and fTerrain].MoveCost of 688 1: MoveCost := 50; // plain terrain 689 2: MoveCost := MoveStyle shr 8 and $FF; // heavy terrain 690 else // mountains 691 begin 692 if TimeBeforeStep and $FFF + MoveStyle shr 16 and $7FF <= $800 then 693 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 694 else 695 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $2800; 696 // must wait for next turn 697 if (MoveStyle and msHostile <> 0) and 698 ((FromTile and (fTerrain or fSpecial1) = fDesert) or 699 (FromTile and fTerrain = fArctic)) and 700 (FromTile and (fCity or fRiver or fCanal) = 0) then 701 begin 702 RecoverCost := ($800 - TimeBeforeStep and $FFF) * 5 shr 1; 703 while RecoverCost > 0 do 704 begin 705 Inc(RecoverTurns); 706 Dec(RecoverCost, MoveStyle shr 16 and $7FF); 707 end; 708 end; 709 Result := csOk; 710 if ToTile and fPeace <> 0 then 711 Result := csCheckTerritory; 712 exit; 713 end; 714 end; 715 end; 716 end 717 else 718 MoveCost := MoveStyle and $FF; //move along railroad 719 720 Inc(MoveCost, MoveCost shl CrossCorner); 721 if (MoveStyle and msHostile = 0) or 722 (ToTile and (fTerrain or fSpecial1) <> fDesert) and 723 (ToTile and fTerrain <> fArctic) or (ToTile and 724 (fCity or fRiver or fCanal) <> 0) or (ToTile and fTerImp = tiBase) then 725 RecoverCost := 0 726 else 727 RecoverCost := (MoveCost * 5) shr 1; 728 // damage from movement: MoveCost*DesertThurst/NoCityRecovery 729 if (TimeBeforeStep and $FFF + MoveCost <= $800) and 730 (TimeBeforeStep and $FFF < $800) then 731 TimeAfterStep := TimeBeforeStep + MoveCost 732 else 733 begin 734 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 735 MoveStyle shr 16 and $7FF + MoveCost; // must wait for next turn 736 if (MoveStyle and msHostile <> 0) and 737 ((FromTile and (fTerrain or fSpecial1) = fDesert) or 738 (FromTile and fTerrain = fArctic)) and 739 (FromTile and (fCity or fRiver or fCanal) = 0) and 740 (FromTile and fTerImp <> tiBase) then 741 Inc(RecoverCost, ($800 - TimeBeforeStep and $FFF) * 5 shr 1); 742 end; 743 while RecoverCost > 0 do 744 begin 745 Inc(RecoverTurns); 746 Dec(RecoverCost, MoveStyle shr 16 and $7FF); 747 end; 748 Result := csOk; 749 if ToTile and fPeace <> 0 then 750 Result := csCheckTerritory; 751 end 752 else 753 Result := csForbiddenStep // ZoC violation 754 else 755 Result := csForbiddenTile; 756 end 757 758 else if MoveStyle < msNoGround + $10000000 then 759 begin // ships and aircraft 760 if ((ToTile and fTerrain xor 1 > MoveStyle and fTerrain) and 761 (ToTile and (fCity or fCanal) = 0)) or (ToTile and not FromTile and fPeace <> 0) or 762 (ToTile and (fUnit or fOwned) = fUnit) or (ToTile and 763 (fCity or fOwned) = fCity) then 764 Result := csForbiddenTile 765 else 766 begin 767 MoveCost := 50 shl CrossCorner + 50; 768 if TimeBeforeStep and $FFF + MoveCost <= $800 then 769 TimeAfterStep := TimeBeforeStep + MoveCost 770 else 771 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 772 MoveStyle shr 16 and $7FF + MoveCost; 773 // must wait for next turn 774 Result := csOk; 775 if ToTile and fPeace <> 0 then 776 Result := csCheckTerritory; 777 end; 778 end 779 780 else if MoveStyle < msAlpine + $10000000 then 781 begin // alpine 782 if (ToTile + 1) and fTerrain < fGrass + 1 then 783 Result := csForbiddenTile 784 else if (ToTile and not FromTile and fPeace = 0) and 785 (ToTile and (fUnit or fOwned) <> fUnit) and 786 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then 787 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or 788 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then 789 begin 790 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then 791 MoveCost := 20 // no railroad 792 else 793 MoveCost := MoveStyle and $FF; //move along railroad 794 Inc(MoveCost, MoveCost shl CrossCorner); 795 if (TimeBeforeStep and $FFF + MoveCost <= $800) and 796 (TimeBeforeStep and $FFF < $800) then 797 TimeAfterStep := TimeBeforeStep + MoveCost 798 else 799 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 800 MoveStyle shr 16 and $7FF + MoveCost; 801 // must wait for next turn 802 Result := csOk; 803 if ToTile and fPeace <> 0 then 804 Result := csCheckTerritory; 805 end 806 else 807 Result := csForbiddenStep // ZoC violation 808 else 809 Result := csForbiddenTile; 810 end 811 812 else if MoveStyle < msOver + $10000000 then 813 begin // overweight 814 if (ToTile + 1) and fTerrain < fGrass + 1 then 815 Result := csForbiddenTile 816 else if (ToTile and not FromTile and fPeace = 0) and 817 (ToTile and (fUnit or fOwned) <> fUnit) and 818 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then 819 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or 820 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then 821 begin 822 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then 823 begin // no railroad 824 if (ToTile and (fRoad or fRR or fCity) <> 0) and 825 (FromTile and (fRoad or fRR or fCity) <> 0) or 826 (FromTile and ToTile and (fRiver or fCanal) <> 0) then 827 MoveCost := 40 //move along road, river or canal 828 else 829 begin 830 Result := csForbiddenTile; 831 exit; 832 end; 833 end 834 else 835 MoveCost := MoveStyle and $FF; //move along railroad 836 Inc(MoveCost, MoveCost shl CrossCorner); 837 if (TimeBeforeStep and $FFF + MoveCost <= $800) and 838 (TimeBeforeStep and $FFF < $800) then 839 TimeAfterStep := TimeBeforeStep + MoveCost 840 else 841 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 842 MoveStyle shr 16 and $7FF + MoveCost; 843 // must wait for next turn 844 Result := csOk; 845 if ToTile and fPeace <> 0 then 846 Result := csCheckTerritory; 847 end 848 else 849 Result := csForbiddenStep // ZoC violation 850 else 851 Result := csForbiddenTile; 852 end 853 854 else {if MoveStyle<msSpy+$10000000 then} 855 begin // spies 856 if (ToTile + 1) and fTerrain < fGrass + 1 then 857 Result := csForbiddenTile 858 else if (ToTile and (fUnit or fOwned) <> fUnit) and 859 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then 860 begin 861 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then 862 begin // no railroad 863 if (ToTile and (fRoad or fRR or fCity) <> 0) and 864 (FromTile and (fRoad or fRR or fCity) <> 0) or 865 (FromTile and ToTile and (fRiver or fCanal) <> 0) then 866 MoveCost := 20 //move along road, river or canal 867 else 868 begin 869 case Terrain[ToTile and fTerrain].MoveCost of 870 1: MoveCost := 50; // plain terrain 871 2: MoveCost := MoveStyle shr 8 and $FF; // heavy terrain 872 else // mountains 873 begin 874 if TimeBeforeStep and $FFF + MoveStyle shr 16 and $7FF <= $800 then 875 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 876 else 877 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $2800; 878 // must wait for next turn 879 Result := csOk; 880 exit; 392 881 end; 393 882 end; 394 883 end; 395 396 // check tile for job397 if (TileJob[TestLoc]>jNone)398 and ((MyModel[MyUnit[uix].mix].Kind<>mkSlaves)399 or (TileJob[TestLoc]<>jCity))400 and ((SettlerOfJobLoc[TestLoc]<0) or (DistToLoc[TestLoc]>TestDistance)) then401 begin402 TestScore:=integer(TileJobScore[TestLoc])-DistanceScore*TestDistance;403 if TestScore>BestScore then404 BestCount:=0;405 if TestScore>=BestScore then406 begin407 inc(BestCount);408 if random(BestCount)=0 then409 begin410 BestScore:=TestScore;411 BestLoc:=TestLoc;412 BestJob:=TileJob[TestLoc];413 BestDistance:=TestDistance414 end415 end;416 end;417 TileChecked[TestLoc]:=true;418 end;419 Pile.Free;420 421 if BestJob>jNone then422 begin // new job found for this unit423 if SettlerOfJobLoc[BestLoc]>=0 then424 begin // another unit was already assigned to this job, but is not as close -- reassign that unit!425 JobLocOfSettler[SettlerOfJobLoc[BestLoc]]:=ToAssign;426 UnitsToAssign:=true;427 end;428 JobLocOfSettler[uix]:=BestLoc;429 SettlerOfJobLoc[BestLoc]:=uix;430 DistToLoc[BestLoc]:=BestDistance431 884 end 432 else JobLocOfSettler[uix]:=-1; // no jobs for this settler 433 end; // for uix 434 end; 435 436 // move settlers and start new jobs 437 for uix:=0 to RO.nUn-1 do with MyUnit[uix] do 438 if (Loc>=0) and (Job=jNone) and (JobLocOfSettler[uix]>=0) then 439 begin 440 if Loc<>JobLocOfSettler[uix] then 441 repeat 442 MoveResult:=Unit_Move(uix,JobLocOfSettler[uix]) 443 until (MoveResult<rExecuted) 444 or (MoveResult and (rLocationReached or rMoreTurns or rUnitRemoved)<>0); 445 if (Loc=JobLocOfSettler[uix]) and (Movement>=100) then 446 Unit_StartJob(uix,TileJob[JobLocOfSettler[uix]]); 447 end; 448 end; // JobAssignment_Go 449 450 451 //------------------------------------------------------------------------------ 452 // Map Analysis 453 454 procedure TToolAI.AnalyzeMap; 455 var 456 i,j,Loc,Loc1,V8,Count,Kind,MostIndex: integer; 457 Adjacent: TVicinity8Loc; 458 IndexOfID: array[0..lxmax*lymax-1] of smallint; 459 IDOfIndex: array[0..lxmax*lymax div 2 -1] of smallint; 460 begin 461 fillchar(District, MapSize*4, $FF); 462 for Loc:=0 to MapSize-1 do 463 if Map[Loc] and fTerrain=fUNKNOWN then Formation[Loc]:=nfUndiscovered 464 else if Map[Loc] and fTerrain=fArctic then Formation[Loc]:=nfPole 465 else if Map[Loc] and fPeace<>0 then Formation[Loc]:=nfPeace 466 else 467 begin 468 Formation[Loc]:=Loc; 469 V8_to_Loc(Loc, Adjacent); 470 for V8:=0 to 7 do 471 begin 472 Loc1:=Adjacent[V8]; 473 if (Loc1<Loc) and (Loc1>=0) and (Formation[Loc1]>=0) 474 and ((Map[Loc1] and fTerrain>=fGrass) = (Map[Loc] and fTerrain>=fGrass)) then 475 if Formation[Loc]=Loc then Formation[Loc]:=Formation[Loc1] 476 else if Formation[Loc]<Formation[Loc1] then 477 ReplaceD(@Formation[Formation[Loc1]],@Formation[Loc+1],Formation[Loc1],Formation[Loc]) 478 else if Formation[Loc]>Formation[Loc1] then 479 ReplaceD(@Formation[Formation[Loc]],@Formation[Loc+1],Formation[Loc],Formation[Loc1]); 480 end; 481 if (RO.Territory[Loc]=me) and (Map[Loc] and fTerrain>=fGrass) then 482 begin 483 District[Loc]:=Loc; 484 for V8:=0 to 7 do 485 begin 486 Loc1:=Adjacent[V8]; 487 if (Loc1<Loc) and (Loc1>=0) and (District[Loc1]>=0) then 488 if District[Loc]=Loc then District[Loc]:=District[Loc1] 489 else if District[Loc]<District[Loc1] then 490 ReplaceD(@District[District[Loc1]],@District[Loc+1],District[Loc1],District[Loc]) 491 else if District[Loc]>District[Loc1] then 492 ReplaceD(@District[District[Loc]],@District[Loc+1],District[Loc],District[Loc1]); 493 end 494 end 495 end; 496 497 // sort continents, oceans and districts by size 498 for Kind:=0 to 2 do 499 begin 500 FillChar(IndexOfID,MapSize*2,0); 501 case Kind of 502 0: // continents 503 for Loc:=0 to MapSize-1 do 504 if (Formation[Loc]>=0) and (Map[Loc] and fTerrain>=fGrass) then 505 inc(IndexOfID[Formation[Loc]]); 506 1: // oceans 507 for Loc:=0 to MapSize-1 do 508 if (Formation[Loc]>=0) and (Map[Loc] and fTerrain<fGrass) then 509 inc(IndexOfID[Formation[Loc]]); 510 2: // districts 511 for Loc:=0 to MapSize-1 do 512 if District[Loc]>=0 then 513 inc(IndexOfID[District[Loc]]); 514 end; 515 516 Count:=0; 517 for Loc:=0 to MapSize-1 do if IndexOfID[Loc]>0 then 518 begin 519 IDOfIndex[Count]:=Loc; 520 inc(Count); 521 end; 522 for i:=0 to Count-2 do 523 begin 524 MostIndex:=i; 525 for j:=i+1 to Count-1 do 526 if IndexOfID[IDOfIndex[j]]>IndexOfID[IDOfIndex[MostIndex]] then MostIndex:=j; 527 if MostIndex<>i then 528 begin 529 j:=IDOfIndex[i]; 530 IDOfIndex[i]:=IDOfIndex[MostIndex]; 531 IDOfIndex[MostIndex]:=j; 532 end 533 end; 534 for i:=0 to Count-1 do 535 IndexOfID[IDOfIndex[i]]:=i; 536 537 case Kind of 538 0: // continents 539 begin 540 nContinent:=Count; 541 for Loc:=0 to MapSize-1 do 542 if (Formation[Loc]>=0) and (Map[Loc] and fTerrain>=fGrass) then 543 Formation[Loc]:=IndexOfID[Formation[Loc]]; 544 end; 545 1: // oceans 546 begin 547 nOcean:=Count; 548 for Loc:=0 to MapSize-1 do 549 if (Formation[Loc]>=0) and (Map[Loc] and fTerrain<fGrass) then 550 Formation[Loc]:=IndexOfID[Formation[Loc]]; 551 end; 552 2: // districts 553 begin 554 nDistrict:=Count; 555 for Loc:=0 to MapSize-1 do 556 if District[Loc]>=0 then 557 District[Loc]:=IndexOfID[District[Loc]]; 558 end; 885 else 886 MoveCost := MoveStyle and $FF; //move along railroad 887 Inc(MoveCost, MoveCost shl CrossCorner); 888 if (TimeBeforeStep and $FFF + MoveCost <= $800) and 889 (TimeBeforeStep and $FFF < $800) then 890 TimeAfterStep := TimeBeforeStep + MoveCost 891 else 892 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 - 893 MoveStyle shr 16 and $7FF + MoveCost; 894 // must wait for next turn 895 Result := csOk; 559 896 end 560 end; 561 end; 562 563 564 //------------------------------------------------------------------------------ 565 // Path Finding 566 567 const 568 // basic move styles 569 msGround= $00000000; 570 msNoGround= $10000000; 571 msAlpine= $20000000; 572 msOver= $40000000; 573 msSpy= $50000000; 574 575 // other 576 msHostile= $08000000; 577 578 // bits: |31|30|29|28|27|26 .. 16|15|14|13|12|11|10| 9| 8| 7| 6| 5| 4| 3| 2| 1| 0| 579 // ground: | Basic |Ho| Speed | HeavyCost | RailCost | 580 // other: | Basic | 0| Speed | X X X | MaxTerrType | 581 582 function TToolAI.GetMyMoveStyle(mix,Health: integer): integer; 583 begin 584 with MyModel[mix] do 585 begin 586 result:=Speed shl 16; 587 case Domain of 588 dGround: 589 begin 590 inc(result, (50+(Speed-150)*13 shr 7) shl 8); //HeavyCost 591 if RO.Wonder[woShinkansen].EffectiveOwner<>me then 592 inc(result, Speed*(4*1311) shr 17); // RailCost 593 if (RO.Wonder[woGardens].EffectiveOwner<>me) 594 or (Kind=mkSettler) and (Speed>=200) then 595 inc(result, msHostile); 596 if Kind=mkDiplomat then 597 inc(result,msSpy) 598 else if Cap[mcOver]>0 then 599 inc(result,msOver) 600 else if Cap[mcAlpine]>0 then 601 inc(result,msAlpine) 602 else inc(result,msGround); 603 end; 604 dSea: 605 begin 606 result:=Speed; 607 if RO.Wonder[woMagellan].EffectiveOwner=me then inc(result,200); 608 if Health<100 then result:=((result-250)*Health div 5000)*50+250; 609 result:=result shl 16; 610 inc(result,msNoGround); 611 if Cap[mcNav]>0 then inc(result); 612 end; 613 dAir: 614 inc(result,msNoGround+fUNKNOWN xor 1 -1); 615 end; 616 end 617 end; 618 619 function TToolAI.CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: integer; 620 var TimeAfterStep, RecoverTurns: integer; FromTile, ToTile: integer; IsCapture: boolean): integer; 621 var 622 MoveCost,RecoverCost: integer; 623 begin 624 //IsCapture:=true; 625 assert(((FromTile and fTerrain<=fMountains) or (FromTile and fTerrain=fUNKNOWN)) 626 and ((ToTile and fTerrain<=fMountains) or (ToTile and fTerrain=fUNKNOWN))); 627 // do not pass location codes for FromTile and ToTile! 628 RecoverTurns:=0; 629 if MoveStyle<msGround+$10000000 then 630 begin // common ground units 631 if (ToTile+1) and fTerrain<fGrass+1 then 632 result:=csForbiddenTile 633 else if (ToTile and not FromTile and fPeace=0) 634 and (ToTile and (fUnit or fOwned)<>fUnit) 635 and (IsCapture or (ToTile and (fCity or fOwned)<>fCity)) then 636 if (FromTile and fCity<>0) or (ToTile and (fCity or fOwned)=fCity or fOwned) 637 or (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit)<>fInEnemyZoc) then 638 begin // ZoC is ok 639 if (ToTile and (fRR or fCity)=0) or (FromTile and (fRR or fCity)=0) then 640 begin // no railroad 641 if (ToTile and (fRoad or fRR or fCity)<>0) 642 and (FromTile and (fRoad or fRR or fCity)<>0) 643 or (FromTile and ToTile and (fRiver or fCanal)<>0) then 644 MoveCost:=20 //move along road, river or canal 645 else 646 begin 647 case Terrain[ToTile and fTerrain].MoveCost of 648 1: MoveCost:=50; // plain terrain 649 2: MoveCost:=MoveStyle shr 8 and $FF; // heavy terrain 650 else // mountains 651 begin 652 if TimeBeforeStep and $FFF+MoveStyle shr 16 and $7FF<=$800 then 653 TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800 654 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$2800; // must wait for next turn 655 if (MoveStyle and msHostile<>0) 656 and ((FromTile and (fTerrain or fSpecial1)=fDesert) 657 or (FromTile and fTerrain=fArctic)) 658 and (FromTile and (fCity or fRiver or fCanal)=0) then 659 begin 660 RecoverCost:=($800-TimeBeforeStep and $FFF)*5 shr 1; 661 while RecoverCost>0 do 662 begin 663 inc(RecoverTurns); 664 dec(RecoverCost, MoveStyle shr 16 and $7FF); 665 end; 666 end; 667 result:=csOk; 668 if ToTile and fPeace<>0 then 669 result:=csCheckTerritory; 670 exit 671 end; 672 end 673 end 674 end 675 else MoveCost:=MoveStyle and $FF; //move along railroad 676 677 inc(MoveCost,MoveCost shl CrossCorner); 678 if (MoveStyle and msHostile=0) 679 or (ToTile and (fTerrain or fSpecial1)<>fDesert) 680 and (ToTile and fTerrain<>fArctic) 681 or (ToTile and (fCity or fRiver or fCanal)<>0) 682 or (ToTile and fTerImp=tiBase) then 683 RecoverCost:=0 684 else RecoverCost:=(MoveCost*5) shr 1; // damage from movement: MoveCost*DesertThurst/NoCityRecovery 685 if (TimeBeforeStep and $FFF+MoveCost<=$800) and (TimeBeforeStep and $FFF<$800) then 686 TimeAfterStep:=TimeBeforeStep+MoveCost 687 else 688 begin 689 TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 690 if (MoveStyle and msHostile<>0) 691 and ((FromTile and (fTerrain or fSpecial1)=fDesert) 692 or (FromTile and fTerrain=fArctic)) 693 and (FromTile and (fCity or fRiver or fCanal)=0) 694 and (FromTile and fTerImp<>tiBase) then 695 inc(RecoverCost, ($800-TimeBeforeStep and $FFF)*5 shr 1); 696 end; 697 while RecoverCost>0 do 698 begin 699 inc(RecoverTurns); 700 dec(RecoverCost, MoveStyle shr 16 and $7FF); 701 end; 702 result:=csOk; 703 if ToTile and fPeace<>0 then 704 result:=csCheckTerritory 705 end 706 else result:=csForbiddenStep // ZoC violation 707 else result:=csForbiddenTile 708 end 709 710 else if MoveStyle<msNoGround+$10000000 then 711 begin // ships and aircraft 712 if ((ToTile and fTerrain xor 1>MoveStyle and fTerrain) 713 and (ToTile and (fCity or fCanal)=0)) 714 or (ToTile and not FromTile and fPeace<>0) 715 or (ToTile and (fUnit or fOwned)=fUnit) 716 or (ToTile and (fCity or fOwned)=fCity) then 717 result:=csForbiddenTile 718 else 719 begin 720 MoveCost:=50 shl CrossCorner+50; 721 if TimeBeforeStep and $FFF+MoveCost<=$800 then 722 TimeAfterStep:=TimeBeforeStep+MoveCost 723 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 724 result:=csOk; 725 if ToTile and fPeace<>0 then 726 result:=csCheckTerritory 727 end 728 end 729 730 else if MoveStyle<msAlpine+$10000000 then 731 begin // alpine 732 if (ToTile+1) and fTerrain<fGrass+1 then 733 result:=csForbiddenTile 734 else if (ToTile and not FromTile and fPeace=0) 735 and (ToTile and (fUnit or fOwned)<>fUnit) 736 and (IsCapture or (ToTile and (fCity or fOwned)<>fCity)) then 737 if (FromTile and fCity<>0) or (ToTile and (fCity or fOwned)=fCity or fOwned) 738 or (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit)<>fInEnemyZoc) then 739 begin 740 if (ToTile and (fRR or fCity)=0) or (FromTile and (fRR or fCity)=0) then 741 MoveCost:=20 // no railroad 742 else MoveCost:=MoveStyle and $FF; //move along railroad 743 inc(MoveCost,MoveCost shl CrossCorner); 744 if (TimeBeforeStep and $FFF+MoveCost<=$800) and (TimeBeforeStep and $FFF<$800) then 745 TimeAfterStep:=TimeBeforeStep+MoveCost 746 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 747 result:=csOk; 748 if ToTile and fPeace<>0 then 749 result:=csCheckTerritory 750 end 751 else result:=csForbiddenStep // ZoC violation 752 else result:=csForbiddenTile 753 end 754 755 else if MoveStyle<msOver+$10000000 then 756 begin // overweight 757 if (ToTile+1) and fTerrain<fGrass+1 then 758 result:=csForbiddenTile 759 else if (ToTile and not FromTile and fPeace=0) 760 and (ToTile and (fUnit or fOwned)<>fUnit) 761 and (IsCapture or (ToTile and (fCity or fOwned)<>fCity)) then 762 if (FromTile and fCity<>0) or (ToTile and (fCity or fOwned)=fCity or fOwned) 763 or (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit)<>fInEnemyZoc) then 764 begin 765 if (ToTile and (fRR or fCity)=0) or (FromTile and (fRR or fCity)=0) then 766 begin // no railroad 767 if (ToTile and (fRoad or fRR or fCity)<>0) 768 and (FromTile and (fRoad or fRR or fCity)<>0) 769 or (FromTile and ToTile and (fRiver or fCanal)<>0) then 770 MoveCost:=40 //move along road, river or canal 771 else begin result:=csForbiddenTile; exit end 772 end 773 else MoveCost:=MoveStyle and $FF; //move along railroad 774 inc(MoveCost,MoveCost shl CrossCorner); 775 if (TimeBeforeStep and $FFF+MoveCost<=$800) and (TimeBeforeStep and $FFF<$800) then 776 TimeAfterStep:=TimeBeforeStep+MoveCost 777 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 778 result:=csOk; 779 if ToTile and fPeace<>0 then 780 result:=csCheckTerritory 781 end 782 else result:=csForbiddenStep // ZoC violation 783 else result:=csForbiddenTile 784 end 785 786 else {if MoveStyle<msSpy+$10000000 then} 787 begin // spies 788 if (ToTile+1) and fTerrain<fGrass+1 then 789 result:=csForbiddenTile 790 else if (ToTile and (fUnit or fOwned)<>fUnit) 791 and (IsCapture or (ToTile and (fCity or fOwned)<>fCity)) then 792 begin 793 if (ToTile and (fRR or fCity)=0) or (FromTile and (fRR or fCity)=0) then 794 begin // no railroad 795 if (ToTile and (fRoad or fRR or fCity)<>0) 796 and (FromTile and (fRoad or fRR or fCity)<>0) 797 or (FromTile and ToTile and (fRiver or fCanal)<>0) then 798 MoveCost:=20 //move along road, river or canal 799 else 800 begin 801 case Terrain[ToTile and fTerrain].MoveCost of 802 1: MoveCost:=50; // plain terrain 803 2: MoveCost:=MoveStyle shr 8 and $FF; // heavy terrain 804 else // mountains 805 begin 806 if TimeBeforeStep and $FFF+MoveStyle shr 16 and $7FF<=$800 then 807 TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800 808 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$2800; // must wait for next turn 809 result:=csOk; 810 exit 811 end; 812 end 813 end 814 end 815 else MoveCost:=MoveStyle and $FF; //move along railroad 816 inc(MoveCost,MoveCost shl CrossCorner); 817 if (TimeBeforeStep and $FFF+MoveCost<=$800) and (TimeBeforeStep and $FFF<$800) then 818 TimeAfterStep:=TimeBeforeStep+MoveCost 819 else TimeAfterStep:=TimeBeforeStep and $7FFFF000+$1800-MoveStyle shr 16 and $7FF+MoveCost; // must wait for next turn 820 result:=csOk; 821 end 822 else result:=csForbiddenTile 897 else 898 Result := csForbiddenTile; 823 899 end; 824 900 end; // CheckStep … … 860 936 *) 861 937 862 function TToolAI.Unit_MoveEx(uix,ToLoc: integer; Options: integer): integer; 863 var 864 Loc,NextLoc,Temp,FromLoc,EndLoc,Time,V8,MoveResult,RecoverTurns,NextTime, 865 MoveStyle: integer; 866 Adjacent: TVicinity8Loc; 867 PreLoc: array[0..lxmax*lymax-1] of integer; 868 Reached: array[0..lxmax*lymax-1] of boolean; 869 begin 870 result:=eOk; 871 FromLoc:=MyUnit[uix].Loc; 872 if FromLoc=ToLoc then exit; 873 874 FillChar(Reached,MapSize,false); 875 MoveStyle:=GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health); 876 EndLoc:=-1; 877 Pile.Create(MapSize); 878 Pile.Put(FromLoc, $800-MyUnit[uix].Movement); 879 while Pile.Get(Loc,Time) do 938 function TToolAI.Unit_MoveEx(uix, ToLoc: integer; Options: integer): integer; 939 var 940 Loc, NextLoc, Temp, FromLoc, EndLoc, Time, V8, MoveResult, RecoverTurns, 941 NextTime, MoveStyle: integer; 942 Adjacent: TVicinity8Loc; 943 PreLoc: array[0..lxmax * lymax - 1] of integer; 944 Reached: array[0..lxmax * lymax - 1] of boolean; 945 begin 946 Result := eOk; 947 FromLoc := MyUnit[uix].Loc; 948 if FromLoc = ToLoc then 949 exit; 950 951 FillChar(Reached, MapSize, False); 952 MoveStyle := GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health); 953 EndLoc := -1; 954 Pile.Create(MapSize); 955 Pile.Put(FromLoc, $800 - MyUnit[uix].Movement); 956 while Pile.Get(Loc, Time) do 880 957 begin 881 if (Loc=ToLoc)882 or (ToLoc=maNextCity) and (Map[Loc] and fCity<>0)883 and (Map[Loc] and fOwned<>0) then884 begin EndLoc:=Loc; Break; end;885 Reached[Loc]:=true;886 V8_to_Loc(Loc,Adjacent);887 for V8:=0 to 7 do888 begin889 NextLoc:=Adjacent[V8];890 if NextLoc>=0 then891 if (NextLoc=ToLoc) and (Options and mxAdjacent<>0) then892 begin EndLoc:=Loc; Break end893 else if not Reached[NextLoc]then958 if (Loc = ToLoc) or (ToLoc = maNextCity) and (Map[Loc] and fCity <> 0) and 959 (Map[Loc] and fOwned <> 0) then 960 begin 961 EndLoc := Loc; 962 Break; 963 end; 964 Reached[Loc] := True; 965 V8_to_Loc(Loc, Adjacent); 966 for V8 := 0 to 7 do 967 begin 968 NextLoc := Adjacent[V8]; 969 if NextLoc >= 0 then 970 if (NextLoc = ToLoc) and (Options and mxAdjacent <> 0) then 894 971 begin 895 case CheckStep(MoveStyle, Time, V8 and 1, NextTime, RecoverTurns, 896 Map[Loc], Map[NextLoc], NextLoc=ToLoc) of 897 csOk: 898 if Pile.Put(NextLoc, NextTime+RecoverTurns*$1000) then 899 PreLoc[NextLoc]:=Loc; 900 csForbiddenTile: 901 Reached[NextLoc]:=true; // don't check moving there again 902 csCheckTerritory: 903 if RO.Territory[NextLoc]=RO.Territory[Loc] then 904 if Pile.Put(NextLoc, NextTime+RecoverTurns*$1000) then 905 PreLoc[NextLoc]:=Loc; 906 end 972 EndLoc := Loc; 973 Break; 907 974 end 908 end; 909 if EndLoc>=0 then Break; 910 end; 911 Pile.Free; 912 913 if EndLoc>=0 then 975 else if not Reached[NextLoc] then 976 begin 977 case CheckStep(MoveStyle, Time, V8 and 1, NextTime, RecoverTurns, 978 Map[Loc], Map[NextLoc], NextLoc = ToLoc) of 979 csOk: 980 if Pile.Put(NextLoc, NextTime + RecoverTurns * $1000) then 981 PreLoc[NextLoc] := Loc; 982 csForbiddenTile: 983 Reached[NextLoc] := True; // don't check moving there again 984 csCheckTerritory: 985 if RO.Territory[NextLoc] = RO.Territory[Loc] then 986 if Pile.Put(NextLoc, NextTime + RecoverTurns * $1000) then 987 PreLoc[NextLoc] := Loc; 988 end; 989 end; 990 end; 991 if EndLoc >= 0 then 992 Break; 993 end; 994 Pile.Free; 995 996 if EndLoc >= 0 then 914 997 begin 915 Loc:=EndLoc;916 NextLoc:=PreLoc[Loc];917 while Loc<>FromLoc do998 Loc := EndLoc; 999 NextLoc := PreLoc[Loc]; 1000 while Loc <> FromLoc do 918 1001 begin // invert meaning of PreLoc 919 Temp:=Loc; 920 Loc:=NextLoc; 921 NextLoc:=PreLoc[Loc]; 922 PreLoc[Loc]:=Temp; 923 end; 924 while Loc<>EndLoc do 925 begin 926 Loc:=PreLoc[Loc]; 927 MoveResult:=Unit_Step(uix, Loc); 928 if (MoveResult<>eOK) and (MoveResult<>eLoaded) then 929 begin result:=MoveResult; break end; 1002 Temp := Loc; 1003 Loc := NextLoc; 1004 NextLoc := PreLoc[Loc]; 1005 PreLoc[Loc] := Temp; 1006 end; 1007 while Loc <> EndLoc do 1008 begin 1009 Loc := PreLoc[Loc]; 1010 MoveResult := Unit_Step(uix, Loc); 1011 if (MoveResult <> eOK) and (MoveResult <> eLoaded) then 1012 begin 1013 Result := MoveResult; 1014 break; 1015 end; 930 1016 end; 931 1017 end 932 else result:=eNoWay; 1018 else 1019 Result := eNoWay; 933 1020 end; 934 1021 … … 939 1026 procedure TToolAI.SeaTransport_BeginInitialize; 940 1027 begin 941 fillchar(TransportAvailable, RO.nUn*sizeof(integer), $FF); // -1942 InitComplete:=false;943 HaveDestinations:=false;944 nTransportLoad:=0;945 TransportMoveStyle:=0;946 TransportCapacity:=$100;947 Pile.Create(MapSize);1028 fillchar(TransportAvailable, RO.nUn * sizeof(integer), $FF); // -1 1029 InitComplete := False; 1030 HaveDestinations := False; 1031 nTransportLoad := 0; 1032 TransportMoveStyle := 0; 1033 TransportCapacity := $100; 1034 Pile.Create(MapSize); 948 1035 end; 949 1036 950 1037 procedure TToolAI.SeaTransport_AddLoad(uix: integer); 951 1038 var 952 i: integer; 953 begin 954 assert(not InitComplete); // call order violation! 955 if Map[MyUnit[uix].Loc] and fTerrain<fGrass then exit; 956 for i:=0 to nTransportLoad-1 do 957 if uix=uixTransportLoad[i] then exit; 958 uixTransportLoad[nTransportLoad]:=uix; 959 inc(nTransportLoad); 1039 i: integer; 1040 begin 1041 assert(not InitComplete); // call order violation! 1042 if Map[MyUnit[uix].Loc] and fTerrain < fGrass then 1043 exit; 1044 for i := 0 to nTransportLoad - 1 do 1045 if uix = uixTransportLoad[i] then 1046 exit; 1047 uixTransportLoad[nTransportLoad] := uix; 1048 Inc(nTransportLoad); 960 1049 end; 961 1050 962 1051 procedure TToolAI.SeaTransport_AddTransport(uix: integer); 963 1052 var 964 MoveStyle: integer;965 begin 966 assert(not InitComplete); // call order violation!967 assert(MyModel[MyUnit[uix].mix].Cap[mcSeaTrans]>0);968 TransportAvailable[uix]:=1;969 with MyModel[MyUnit[uix].mix] do1053 MoveStyle: integer; 1054 begin 1055 assert(not InitComplete); // call order violation! 1056 assert(MyModel[MyUnit[uix].mix].Cap[mcSeaTrans] > 0); 1057 TransportAvailable[uix] := 1; 1058 with MyModel[MyUnit[uix].mix] do 970 1059 begin 971 if MTrans*Cap[mcSeaTrans]<TransportCapacity then 972 TransportCapacity:=MTrans*Cap[mcSeaTrans]; 973 MoveStyle:=GetMyMoveStyle(MyUnit[uix].mix, 100); 974 if (TransportMoveStyle=0) 975 or (MoveStyle<TransportMoveStyle) 976 and (MoveStyle and not TransportMoveStyle and 1=0) 977 or (not MoveStyle and TransportMoveStyle and 1<>0) then 978 TransportMoveStyle:=MoveStyle; 979 end 1060 if MTrans * Cap[mcSeaTrans] < TransportCapacity then 1061 TransportCapacity := MTrans * Cap[mcSeaTrans]; 1062 MoveStyle := GetMyMoveStyle(MyUnit[uix].mix, 100); 1063 if (TransportMoveStyle = 0) or (MoveStyle < TransportMoveStyle) and 1064 (MoveStyle and not TransportMoveStyle and 1 = 0) or 1065 (not MoveStyle and TransportMoveStyle and 1 <> 0) then 1066 TransportMoveStyle := MoveStyle; 1067 end; 980 1068 end; 981 1069 982 1070 procedure TToolAI.SeaTransport_AddDestination(Loc: integer); 983 1071 begin 984 assert(not InitComplete); // call order violation!985 Pile.Put(Loc, $800);986 HaveDestinations:=true;1072 assert(not InitComplete); // call order violation! 1073 Pile.Put(Loc, $800); 1074 HaveDestinations := True; 987 1075 end; 988 1076 989 1077 procedure TToolAI.SeaTransport_EndInitialize; 990 1078 var 991 Loc0,Time0,V8,Loc1,ArriveTime,RecoverTurns: integer;992 Adjacent: TVicinity8Loc;993 begin 994 assert(not InitComplete); // call order violation!995 InitComplete:=true;996 if HaveDestinations then1079 Loc0, Time0, V8, Loc1, ArriveTime, RecoverTurns: integer; 1080 Adjacent: TVicinity8Loc; 1081 begin 1082 assert(not InitComplete); // call order violation! 1083 InitComplete := True; 1084 if HaveDestinations then 997 1085 begin // calculate TurnsAfterLoad from destination locs 998 fillchar(TurnsAfterLoad, MapSize, $FF); // -1999 while Pile.Get(Loc0, Time0) do1086 fillchar(TurnsAfterLoad, MapSize, $FF); // -1 1087 while Pile.Get(Loc0, Time0) do 1000 1088 begin // search backward 1001 if Time0=$800 then TurnsAfterLoad[Loc0]:=1 1002 else TurnsAfterLoad[Loc0]:=Time0 shr 12; 1003 V8_to_Loc(Loc0, Adjacent); 1004 for V8:=0 to 7 do 1005 begin 1006 Loc1:=Adjacent[V8]; 1007 if (Loc1>=0) and (TurnsAfterLoad[Loc1]=-1) then 1089 if Time0 = $800 then 1090 TurnsAfterLoad[Loc0] := 1 1091 else 1092 TurnsAfterLoad[Loc0] := Time0 shr 12; 1093 V8_to_Loc(Loc0, Adjacent); 1094 for V8 := 0 to 7 do 1095 begin 1096 Loc1 := Adjacent[V8]; 1097 if (Loc1 >= 0) and (TurnsAfterLoad[Loc1] = -1) then 1008 1098 begin 1009 case CheckStep(TransportMoveStyle, Time0, V8 and 1, ArriveTime,1010 RecoverTurns, Map[Loc0], Map[Loc1], false) of1011 csOk: Pile.Put(Loc1, ArriveTime);1012 csForbiddenStep: TurnsAfterLoad[Loc1]:=-2;1099 case CheckStep(TransportMoveStyle, Time0, V8 and 1, ArriveTime, 1100 RecoverTurns, Map[Loc0], Map[Loc1], False) of 1101 csOk: Pile.Put(Loc1, ArriveTime); 1102 csForbiddenStep: TurnsAfterLoad[Loc1] := -2; 1013 1103 end; 1014 end 1015 end 1016 end; 1017 end; 1018 Pile.Free; 1019 end; 1020 1021 1022 function TToolAI.SeaTransport_MakeGroupPlan(var TransportPlan: TGroupTransportPlan): boolean; 1023 var 1024 V8,i,j,iPicked,uix,Loc0,Time0,Loc1,RecoverTurns,MoveStyle, TurnsLoaded, 1025 TurnCount, tuix, tuix1, ArriveTime, TotalDelay, BestTotalDelay, GroupCount, 1026 BestGroupCount, BestLoadLoc, FullMovementLoc, nSelectedLoad, f, 1027 OriginContinent,a,b: integer; 1028 CompleteFlag, NotReachedFlag, ContinueUnit: Cardinal; 1029 IsComplete,ok,IsFirstLoc: boolean; 1030 StartLocPtr, ArrivedEnd: pinteger; 1031 Adjacent: TVicinity8Loc; 1032 uixSelectedLoad: array[0..15] of integer; 1033 tuixSelectedLoad: array[0..15] of integer; 1034 Arrived: array[0..lxmax*lymax] of cardinal; 1035 ResponsibleTransport: array[0..lxmax*lymax-1] of smallint; 1036 TurnsBeforeLoad: array[0..lxmax*lymax-1] of shortint; 1037 GroupComplete: array[0..lxmax*lymax-1] of boolean; 1038 begin 1039 assert(InitComplete); // call order violation! 1040 1041 if HaveDestinations and (nTransportLoad>0) then 1104 end; 1105 end; 1106 end; 1107 end; 1108 Pile.Free; 1109 end; 1110 1111 1112 function TToolAI.SeaTransport_MakeGroupPlan( 1113 var TransportPlan: TGroupTransportPlan): boolean; 1114 var 1115 V8, i, j, iPicked, uix, Loc0, Time0, Loc1, RecoverTurns, MoveStyle, 1116 TurnsLoaded, TurnCount, tuix, tuix1, ArriveTime, TotalDelay, 1117 BestTotalDelay, GroupCount, BestGroupCount, BestLoadLoc, FullMovementLoc, 1118 nSelectedLoad, f, OriginContinent, a, b: integer; 1119 CompleteFlag, NotReachedFlag, ContinueUnit: cardinal; 1120 IsComplete, ok, IsFirstLoc: boolean; 1121 StartLocPtr, ArrivedEnd: pinteger; 1122 Adjacent: TVicinity8Loc; 1123 uixSelectedLoad: array[0..15] of integer; 1124 tuixSelectedLoad: array[0..15] of integer; 1125 Arrived: array[0..lxmax * lymax] of cardinal; 1126 ResponsibleTransport: array[0..lxmax * lymax - 1] of smallint; 1127 TurnsBeforeLoad: array[0..lxmax * lymax - 1] of shortint; 1128 GroupComplete: array[0..lxmax * lymax - 1] of boolean; 1129 begin 1130 assert(InitComplete); // call order violation! 1131 1132 if HaveDestinations and (nTransportLoad > 0) then 1042 1133 begin // transport and units already adjacent? 1043 for uix:=0 to RO.nUn-1 do1044 if (TransportAvailable[uix]>0)1045 and (Map[MyUnit[uix].Loc] and fTerrain=fShore) then1046 begin 1047 GroupCount:=0;1048 for tuix:=0 to nTransportLoad-1 do1134 for uix := 0 to RO.nUn - 1 do 1135 if (TransportAvailable[uix] > 0) and (Map[MyUnit[uix].Loc] and 1136 fTerrain = fShore) then 1137 begin 1138 GroupCount := 0; 1139 for tuix := 0 to nTransportLoad - 1 do 1049 1140 begin 1050 Loc_to_ab(MyUnit[uix].Loc, MyUnit[uixTransportLoad[tuix]].Loc, a, b);1051 if (abs(a)<=1) and (abs(b)<=1) then1141 Loc_to_ab(MyUnit[uix].Loc, MyUnit[uixTransportLoad[tuix]].Loc, a, b); 1142 if (abs(a) <= 1) and (abs(b) <= 1) then 1052 1143 begin 1053 assert((a<>0) or (b<>0));1054 inc(GroupCount);1055 end 1144 assert((a <> 0) or (b <> 0)); 1145 Inc(GroupCount); 1146 end; 1056 1147 end; 1057 if (GroupCount=nTransportLoad) or (GroupCount>=TransportCapacity) then1148 if (GroupCount = nTransportLoad) or (GroupCount >= TransportCapacity) then 1058 1149 begin 1059 TransportPlan.LoadLoc:=MyUnit[uix].Loc;1060 TransportPlan.uixTransport:=uix;1061 TransportAvailable[uix]:=0;1062 TransportPlan.TurnsEmpty:=0;1063 TransportPlan.TurnsLoaded:=TurnsAfterLoad[TransportPlan.LoadLoc];1064 TransportPlan.nLoad:=0;1065 for tuix:=nTransportLoad-1 downto 0 do1150 TransportPlan.LoadLoc := MyUnit[uix].Loc; 1151 TransportPlan.uixTransport := uix; 1152 TransportAvailable[uix] := 0; 1153 TransportPlan.TurnsEmpty := 0; 1154 TransportPlan.TurnsLoaded := TurnsAfterLoad[TransportPlan.LoadLoc]; 1155 TransportPlan.nLoad := 0; 1156 for tuix := nTransportLoad - 1 downto 0 do 1066 1157 begin 1067 Loc_to_ab(TransportPlan.LoadLoc, MyUnit[uixTransportLoad[tuix]].Loc, a, b);1068 if (abs(a)<=1) and (abs(b)<=1) then1158 Loc_to_ab(TransportPlan.LoadLoc, MyUnit[uixTransportLoad[tuix]].Loc, a, b); 1159 if (abs(a) <= 1) and (abs(b) <= 1) then 1069 1160 begin 1070 TransportPlan.uixLoad[TransportPlan.nLoad]:=uixTransportLoad[tuix]; 1071 uixTransportLoad[tuix]:=uixTransportLoad[nTransportLoad-1]; 1072 dec(nTransportLoad); 1073 inc(TransportPlan.nLoad); 1074 if TransportPlan.nLoad=TransportCapacity then break; 1161 TransportPlan.uixLoad[TransportPlan.nLoad] := uixTransportLoad[tuix]; 1162 uixTransportLoad[tuix] := uixTransportLoad[nTransportLoad - 1]; 1163 Dec(nTransportLoad); 1164 Inc(TransportPlan.nLoad); 1165 if TransportPlan.nLoad = TransportCapacity then 1166 break; 1075 1167 end; 1076 1168 end; 1077 result:=true;1078 exit;1079 end 1080 end 1081 end; 1082 1083 while HaveDestinations and (nTransportLoad>0) do1169 Result := True; 1170 exit; 1171 end; 1172 end; 1173 end; 1174 1175 while HaveDestinations and (nTransportLoad > 0) do 1084 1176 begin 1085 // select units from same continent 1086 fillchar(Arrived, 4*nContinent, 0); // misuse Arrived as counter 1087 for tuix:=0 to nTransportLoad-1 do 1088 begin 1089 assert(Map[MyUnit[uixTransportLoad[tuix]].Loc] and fTerrain>=fGrass); 1090 f:=Formation[MyUnit[uixTransportLoad[tuix]].Loc]; 1091 if f>=0 then inc(Arrived[f]); 1092 end; 1093 OriginContinent:=0; 1094 for f:=1 to nContinent-1 do 1095 if Arrived[f]>Arrived[OriginContinent] then OriginContinent:=f; 1096 nSelectedLoad:=0; 1097 for tuix:=0 to nTransportLoad-1 do 1098 if Formation[MyUnit[uixTransportLoad[tuix]].Loc]=OriginContinent then 1099 begin 1100 tuixSelectedLoad[nSelectedLoad]:=tuix; 1101 uixSelectedLoad[nSelectedLoad]:=uixTransportLoad[tuix]; 1102 inc(nSelectedLoad); 1103 if nSelectedLoad=16 then break; 1104 end; 1105 1106 Pile.Create(MapSize); 1107 fillchar(ResponsibleTransport, MapSize*2, $FF); // -1 1108 fillchar(TurnsBeforeLoad, MapSize, $FF); // -1 1109 ok:=false; 1110 for uix:=0 to RO.nUn-1 do if TransportAvailable[uix]>0 then 1111 begin 1112 ok:=true; 1113 Pile.Put(MyUnit[uix].Loc, ($800-MyUnit[uix].Movement) shl 12 + uix); 1114 end; 1115 if not ok then // no transports 1116 begin TransportPlan.LoadLoc:=-1; result:=false; Pile.Free; exit end; 1117 while Pile.Get(Loc0, Time0) do 1118 begin 1119 uix:=Time0 and $FFF; 1120 Time0:=Time0 shr 12; 1121 ResponsibleTransport[Loc0]:=uix; 1122 TurnsBeforeLoad[Loc0]:=Time0 shr 12; 1123 V8_to_Loc(Loc0, Adjacent); 1124 for V8:=0 to 7 do 1125 begin 1126 Loc1:=Adjacent[V8]; 1127 if (Loc1>=0) and (ResponsibleTransport[Loc1]<0) then 1128 case CheckStep(GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health), 1129 Time0, V8 and 1, ArriveTime, RecoverTurns, Map[Loc0], Map[Loc1], false) of 1130 csOk: Pile.Put(Loc1, ArriveTime shl 12 + uix); 1131 csForbiddenTile: ResponsibleTransport[Loc1]:=RO.nUn; // don't check again 1177 // select units from same continent 1178 fillchar(Arrived, 4 * nContinent, 0); // misuse Arrived as counter 1179 for tuix := 0 to nTransportLoad - 1 do 1180 begin 1181 assert(Map[MyUnit[uixTransportLoad[tuix]].Loc] and fTerrain >= fGrass); 1182 f := Formation[MyUnit[uixTransportLoad[tuix]].Loc]; 1183 if f >= 0 then 1184 Inc(Arrived[f]); 1185 end; 1186 OriginContinent := 0; 1187 for f := 1 to nContinent - 1 do 1188 if Arrived[f] > Arrived[OriginContinent] then 1189 OriginContinent := f; 1190 nSelectedLoad := 0; 1191 for tuix := 0 to nTransportLoad - 1 do 1192 if Formation[MyUnit[uixTransportLoad[tuix]].Loc] = OriginContinent then 1193 begin 1194 tuixSelectedLoad[nSelectedLoad] := tuix; 1195 uixSelectedLoad[nSelectedLoad] := uixTransportLoad[tuix]; 1196 Inc(nSelectedLoad); 1197 if nSelectedLoad = 16 then 1198 break; 1199 end; 1200 1201 Pile.Create(MapSize); 1202 fillchar(ResponsibleTransport, MapSize * 2, $FF); // -1 1203 fillchar(TurnsBeforeLoad, MapSize, $FF); // -1 1204 ok := False; 1205 for uix := 0 to RO.nUn - 1 do 1206 if TransportAvailable[uix] > 0 then 1207 begin 1208 ok := True; 1209 Pile.Put(MyUnit[uix].Loc, ($800 - MyUnit[uix].Movement) shl 12 + uix); 1210 end; 1211 if not ok then // no transports 1212 begin 1213 TransportPlan.LoadLoc := -1; 1214 Result := False; 1215 Pile.Free; 1216 exit; 1217 end; 1218 while Pile.Get(Loc0, Time0) do 1219 begin 1220 uix := Time0 and $FFF; 1221 Time0 := Time0 shr 12; 1222 ResponsibleTransport[Loc0] := uix; 1223 TurnsBeforeLoad[Loc0] := Time0 shr 12; 1224 V8_to_Loc(Loc0, Adjacent); 1225 for V8 := 0 to 7 do 1226 begin 1227 Loc1 := Adjacent[V8]; 1228 if (Loc1 >= 0) and (ResponsibleTransport[Loc1] < 0) then 1229 case CheckStep(GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health), 1230 Time0, V8 and 1, ArriveTime, RecoverTurns, Map[Loc0], Map[Loc1], False) of 1231 csOk: Pile.Put(Loc1, ArriveTime shl 12 + uix); 1232 csForbiddenTile: ResponsibleTransport[Loc1] := RO.nUn; // don't check again 1233 end; 1234 end; 1235 end; 1236 1237 fillchar(Arrived, MapSize * 4, $55); // set NotReachedFlag for all tiles 1238 fillchar(GroupComplete, MapSize, False); 1239 BestLoadLoc := -1; 1240 1241 // check direct loading 1242 for tuix := 0 to nSelectedLoad - 1 do 1243 begin 1244 uix := uixSelectedLoad[tuix]; 1245 if MyUnit[uix].Movement = integer(MyModel[MyUnit[uix].mix].Speed) then 1246 begin 1247 NotReachedFlag := 1 shl (2 * tuix); 1248 CompleteFlag := NotReachedFlag shl 1; 1249 V8_to_Loc(MyUnit[uix].Loc, Adjacent); 1250 for V8 := 0 to 7 do 1251 begin 1252 Loc1 := Adjacent[V8]; 1253 if (Loc1 >= 0) and (Map[Loc1] and fTerrain < fGrass) and 1254 not GroupComplete[Loc1] then 1255 begin // possible transport start location 1256 Arrived[Loc1] := (Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1257 if (TurnsBeforeLoad[Loc1] >= 0) and (TurnsAfterLoad[Loc1] >= 0) then 1258 begin 1259 i := 1; 1260 GroupCount := 0; 1261 for tuix1 := 0 to nSelectedLoad - 1 do 1262 begin 1263 if Arrived[loc1] and i = 0 then 1264 Inc(GroupCount); 1265 i := i shl 2; 1266 end; 1267 assert(GroupCount <= TransportCapacity); 1268 if (GroupCount = TransportCapacity) or (GroupCount = nSelectedLoad) then 1269 GroupComplete[loc1] := True; 1270 TotalDelay := TurnsBeforeLoad[Loc1] + TurnsAfterLoad[Loc1]; 1271 if (BestLoadLoc < 0) or (GroupCount shl 16 - 1272 TotalDelay > BestGroupCount shl 16 - BestTotalDelay) then 1273 begin 1274 BestLoadLoc := Loc1; 1275 BestGroupCount := GroupCount; 1276 BestTotalDelay := TotalDelay; 1277 end; 1278 end; 1279 end; 1280 end; 1281 end; 1282 end; 1283 1284 TurnCount := 0; 1285 ArrivedEnd := @Arrived[MapSize]; 1286 1287 // check moving+loading 1288 ContinueUnit := 1 shl nSelectedLoad - 1; 1289 while (ContinueUnit > 0) and ((BestLoadLoc < 0) or 1290 (TurnCount < BestTotalDelay - 2)) do 1291 begin 1292 for tuix := 0 to nSelectedLoad - 1 do 1293 if 1 shl tuix and ContinueUnit <> 0 then 1294 begin 1295 uix := uixSelectedLoad[tuix]; 1296 MoveStyle := GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health); 1297 NotReachedFlag := 1 shl (2 * tuix); 1298 CompleteFlag := NotReachedFlag shl 1; 1299 FullMovementLoc := -1; 1300 1301 Pile.Empty; 1302 if TurnCount = 0 then 1303 begin 1304 Pile.Put(MyUnit[uix].Loc, $1800 - MyUnit[uix].Movement); 1305 if MyUnit[uix].Movement = integer(MyModel[MyUnit[uix].mix].Speed) then 1306 FullMovementLoc := MyUnit[uix].Loc; 1307 // surrounding tiles can be loaded immediately 1308 StartLocPtr := ArrivedEnd; 1132 1309 end 1133 end 1134 end; 1135 1136 fillchar(Arrived, MapSize*4, $55); // set NotReachedFlag for all tiles 1137 fillchar(GroupComplete, MapSize, false); 1138 BestLoadLoc:=-1; 1139 1140 // check direct loading 1141 for tuix:=0 to nSelectedLoad-1 do 1142 begin 1143 uix:=uixSelectedLoad[tuix]; 1144 if MyUnit[uix].Movement=integer(MyModel[MyUnit[uix].mix].Speed) then 1145 begin 1146 NotReachedFlag:=1 shl (2*tuix); 1147 CompleteFlag:=NotReachedFlag shl 1; 1148 V8_to_Loc(MyUnit[uix].Loc, Adjacent); 1149 for V8:=0 to 7 do 1310 else 1311 StartLocPtr := @Arrived; 1312 IsFirstLoc := True; 1313 1314 repeat 1315 if StartLocPtr <> ArrivedEnd then 1316 // search next movement start location for this turn 1317 StartLocPtr := NextZero(StartLocPtr, ArrivedEnd, 1318 CompleteFlag or NotReachedFlag); 1319 if StartLocPtr <> ArrivedEnd then 1320 begin 1321 Loc0 := (integer(StartLocPtr) - integer(@Arrived)) shr 2; 1322 Inc(StartLocPtr); 1323 Time0 := $800; 1324 end 1325 else if not Pile.Get(Loc0, Time0) then 1326 begin 1327 if IsFirstLoc then 1328 ContinueUnit := ContinueUnit and not (1 shl tuix); 1329 break; 1330 end; 1331 IsFirstLoc := False; 1332 1333 Arrived[Loc0] := Arrived[Loc0] and not NotReachedFlag; 1334 if not GroupComplete[Loc0] and (Map[Loc0] and fTerrain <> fMountains) then 1335 begin // check whether group complete -- no mountains because complete flag might be faked there 1336 i := 1; 1337 GroupCount := 0; 1338 for tuix1 := 0 to nSelectedLoad - 1 do 1339 begin 1340 if Arrived[Loc0] and i = 0 then 1341 Inc(GroupCount); 1342 i := i shl 2; 1343 end; 1344 assert(GroupCount <= TransportCapacity); 1345 if (GroupCount = TransportCapacity) or (GroupCount = nSelectedLoad) then 1346 GroupComplete[Loc0] := True; 1347 end; 1348 1349 V8_to_Loc(Loc0, Adjacent); 1350 IsComplete := True; 1351 for V8 := 0 to 7 do 1352 begin 1353 Loc1 := Adjacent[V8]; 1354 if (Loc1 < G.ly) or (Loc1 >= MapSize - G.ly) then 1355 Adjacent[V8] := -1 // pole, don't consider moving here 1356 else if Arrived[Loc1] and NotReachedFlag = 0 then 1357 Adjacent[V8] := -1 // unit has already arrived this tile 1358 else if GroupComplete[Loc1] then 1359 Adjacent[V8] := -1 // already other group complete 1360 else if Map[Loc1] and fTerrain < fGrass then 1361 begin // possible transport start location 1362 Arrived[Loc1] := (Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1363 Adjacent[V8] := -1; 1364 if (TurnsBeforeLoad[Loc1] >= 0) and (TurnsAfterLoad[Loc1] >= 0) then 1365 begin 1366 i := 1; 1367 GroupCount := 0; 1368 for tuix1 := 0 to nSelectedLoad - 1 do 1369 begin 1370 if Arrived[loc1] and i = 0 then 1371 Inc(GroupCount); 1372 i := i shl 2; 1373 end; 1374 assert(GroupCount <= TransportCapacity); 1375 if (GroupCount = TransportCapacity) or 1376 (GroupCount = nSelectedLoad) then 1377 GroupComplete[loc1] := True; 1378 if TurnsBeforeLoad[Loc1] > TurnCount + 1 then 1379 TotalDelay := TurnsBeforeLoad[Loc1] + TurnsAfterLoad[Loc1] 1380 else 1381 TotalDelay := TurnCount + 1 + TurnsAfterLoad[Loc1]; 1382 if (BestLoadLoc < 0) or (GroupCount shl 1383 16 - TotalDelay > BestGroupCount shl 16 - BestTotalDelay) then 1384 begin 1385 BestLoadLoc := Loc1; 1386 BestGroupCount := GroupCount; 1387 BestTotalDelay := TotalDelay; 1388 end; 1389 end; 1390 end 1391 else if (Map[Loc1] and fTerrain = fMountains) and 1392 ((Map[Loc0] and (fRoad or fRR or fCity) = 0) or 1393 (Map[Loc1] and (fRoad or fRR or fCity) = 0)) and 1394 (Map[Loc0] and Map[Loc1] and (fRiver or fCanal) = 0) then 1395 begin // mountain delay too complicated for this algorithm 1396 Arrived[Loc1] := (Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1397 Adjacent[V8] := -1; 1398 end 1399 else 1400 IsComplete := False; 1401 end; 1402 if IsComplete then 1403 begin 1404 Arrived[Loc0] := (Arrived[Loc0] or CompleteFlag) and not NotReachedFlag; 1405 continue; 1406 end; 1407 IsComplete := True; 1408 for V8 := 0 to 7 do 1409 begin 1410 Loc1 := Adjacent[V8]; 1411 if Loc1 >= 0 then 1412 begin 1413 ok := False; 1414 case CheckStep(MoveStyle, Time0, V8 and 1, ArriveTime, 1415 RecoverTurns, Map[Loc0], Map[Loc1], False) of 1416 csOk: ok := True; 1417 csForbiddenTile: 1418 ;// !!! don't check moving there again 1419 csCheckTerritory: 1420 ok := RO.Territory[Loc1] = RO.Territory[Loc0]; 1421 end; 1422 if ok and Pile.TestPut(Loc1, ArriveTime) then 1423 if ArriveTime < $2000 then 1424 Pile.Put(Loc1, ArriveTime) 1425 else 1426 IsComplete := False; 1427 end; 1428 end; 1429 if IsComplete then 1430 Arrived[Loc0] := (Arrived[Loc0] or CompleteFlag) and not NotReachedFlag; 1431 until False; 1432 end; 1433 1434 Inc(TurnCount); 1435 end; 1436 Pile.Free; 1437 1438 if BestLoadLoc >= 0 then 1439 begin 1440 TransportPlan.LoadLoc := BestLoadLoc; 1441 TransportPlan.uixTransport := ResponsibleTransport[BestLoadLoc]; 1442 TransportAvailable[TransportPlan.uixTransport] := 0; 1443 TransportPlan.TurnsEmpty := BestTotalDelay - TurnsAfterLoad[BestLoadLoc]; 1444 TransportPlan.TurnsLoaded := TurnsAfterLoad[BestLoadLoc]; 1445 TransportPlan.nLoad := 0; 1446 for tuix := nSelectedLoad - 1 downto 0 do 1447 if 1 shl (2 * tuix) and Arrived[BestLoadLoc] = 0 then 1150 1448 begin 1151 Loc1:=Adjacent[V8]; 1152 if (Loc1>=0) and (Map[Loc1] and fTerrain<fGrass) 1153 and not GroupComplete[Loc1] then 1154 begin // possible transport start location 1155 Arrived[Loc1]:=(Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1156 if (TurnsBeforeLoad[Loc1]>=0) and (TurnsAfterLoad[Loc1]>=0) then 1157 begin 1158 i:=1; 1159 GroupCount:=0; 1160 for tuix1:=0 to nSelectedLoad-1 do 1161 begin 1162 if Arrived[loc1] and i=0 then inc(GroupCount); 1163 i:=i shl 2; 1164 end; 1165 assert(GroupCount<=TransportCapacity); 1166 if (GroupCount=TransportCapacity) or (GroupCount=nSelectedLoad) then 1167 GroupComplete[loc1]:=true; 1168 TotalDelay:=TurnsBeforeLoad[Loc1]+TurnsAfterLoad[Loc1]; 1169 if (BestLoadLoc<0) 1170 or (GroupCount shl 16-TotalDelay 1171 >BestGroupCount shl 16-BestTotalDelay) then 1172 begin 1173 BestLoadLoc:=Loc1; 1174 BestGroupCount:=GroupCount; 1175 BestTotalDelay:=TotalDelay 1176 end 1177 end 1178 end 1449 assert(uixTransportLoad[tuixSelectedLoad[tuix]] = uixSelectedLoad[tuix]); 1450 TransportPlan.uixLoad[TransportPlan.nLoad] := uixSelectedLoad[tuix]; 1451 uixTransportLoad[tuixSelectedLoad[tuix]] := 1452 uixTransportLoad[nTransportLoad - 1]; 1453 Dec(nTransportLoad); 1454 Inc(TransportPlan.nLoad); 1179 1455 end; 1180 end 1181 end; 1182 1183 TurnCount:=0; 1184 ArrivedEnd:=@Arrived[MapSize]; 1185 1186 // check moving+loading 1187 ContinueUnit:=1 shl nSelectedLoad-1; 1188 while (ContinueUnit>0) and ((BestLoadLoc<0) or (TurnCount<BestTotalDelay-2)) do 1189 begin 1190 for tuix:=0 to nSelectedLoad-1 do if 1 shl tuix and ContinueUnit<>0 then 1191 begin 1192 uix:=uixSelectedLoad[tuix]; 1193 MoveStyle:=GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health); 1194 NotReachedFlag:=1 shl (2*tuix); 1195 CompleteFlag:=NotReachedFlag shl 1; 1196 FullMovementLoc:=-1; 1197 1198 Pile.Empty; 1199 if TurnCount=0 then 1200 begin 1201 Pile.Put(MyUnit[uix].Loc, $1800-MyUnit[uix].Movement); 1202 if MyUnit[uix].Movement=integer(MyModel[MyUnit[uix].mix].Speed) then 1203 FullMovementLoc:=MyUnit[uix].Loc; // surrounding tiles can be loaded immediately 1204 StartLocPtr:=ArrivedEnd; 1205 end 1206 else StartLocPtr:=@Arrived; 1207 IsFirstLoc:=true; 1208 1209 repeat 1210 if StartLocPtr<>ArrivedEnd then // search next movement start location for this turn 1211 StartLocPtr:=NextZero(StartLocPtr, ArrivedEnd, CompleteFlag or NotReachedFlag); 1212 if StartLocPtr<>ArrivedEnd then 1213 begin 1214 Loc0:=(integer(StartLocPtr)-integer(@Arrived)) shr 2; 1215 inc(StartLocPtr); 1216 Time0:=$800 1217 end 1218 else if not Pile.Get(Loc0, Time0) then 1219 begin 1220 if IsFirstLoc then ContinueUnit:=ContinueUnit and not (1 shl tuix); 1221 break; 1222 end; 1223 IsFirstLoc:=false; 1224 1225 Arrived[Loc0]:=Arrived[Loc0] and not NotReachedFlag; 1226 if not GroupComplete[Loc0] and (Map[Loc0] and fTerrain<>fMountains) then 1227 begin // check whether group complete -- no mountains because complete flag might be faked there 1228 i:=1; 1229 GroupCount:=0; 1230 for tuix1:=0 to nSelectedLoad-1 do 1231 begin 1232 if Arrived[Loc0] and i=0 then inc(GroupCount); 1233 i:=i shl 2; 1234 end; 1235 assert(GroupCount<=TransportCapacity); 1236 if (GroupCount=TransportCapacity) or (GroupCount=nSelectedLoad) then 1237 GroupComplete[Loc0]:=true 1238 end; 1239 1240 V8_to_Loc(Loc0, Adjacent); 1241 IsComplete:=true; 1242 for V8:=0 to 7 do 1243 begin 1244 Loc1:=Adjacent[V8]; 1245 if (Loc1<G.ly) or (Loc1>=MapSize-G.ly) then 1246 Adjacent[V8]:=-1 // pole, don't consider moving here 1247 else if Arrived[Loc1] and NotReachedFlag=0 then 1248 Adjacent[V8]:=-1 // unit has already arrived this tile 1249 else if GroupComplete[Loc1] then 1250 Adjacent[V8]:=-1 // already other group complete 1251 else if Map[Loc1] and fTerrain<fGrass then 1252 begin // possible transport start location 1253 Arrived[Loc1]:=(Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1254 Adjacent[V8]:=-1; 1255 if (TurnsBeforeLoad[Loc1]>=0) and (TurnsAfterLoad[Loc1]>=0) then 1256 begin 1257 i:=1; 1258 GroupCount:=0; 1259 for tuix1:=0 to nSelectedLoad-1 do 1260 begin 1261 if Arrived[loc1] and i=0 then inc(GroupCount); 1262 i:=i shl 2; 1263 end; 1264 assert(GroupCount<=TransportCapacity); 1265 if (GroupCount=TransportCapacity) or (GroupCount=nSelectedLoad) then 1266 GroupComplete[loc1]:=true; 1267 if TurnsBeforeLoad[Loc1]>TurnCount+1 then 1268 TotalDelay:=TurnsBeforeLoad[Loc1]+TurnsAfterLoad[Loc1] 1269 else TotalDelay:=TurnCount+1+TurnsAfterLoad[Loc1]; 1270 if (BestLoadLoc<0) 1271 or (GroupCount shl 16-TotalDelay 1272 >BestGroupCount shl 16-BestTotalDelay) then 1273 begin 1274 BestLoadLoc:=Loc1; 1275 BestGroupCount:=GroupCount; 1276 BestTotalDelay:=TotalDelay 1277 end 1278 end 1279 end 1280 else if (Map[Loc1] and fTerrain=fMountains) 1281 and ((Map[Loc0] and (fRoad or fRR or fCity)=0) 1282 or (Map[Loc1] and (fRoad or fRR or fCity)=0)) 1283 and (Map[Loc0] and Map[Loc1] and (fRiver or fCanal)=0) then 1284 begin // mountain delay too complicated for this algorithm 1285 Arrived[Loc1]:=(Arrived[Loc1] or CompleteFlag) and not NotReachedFlag; 1286 Adjacent[V8]:=-1; 1287 end 1288 else IsComplete:=false; 1289 end; 1290 if IsComplete then 1291 begin 1292 Arrived[Loc0]:=(Arrived[Loc0] or CompleteFlag) and not NotReachedFlag; 1293 continue 1294 end; 1295 IsComplete:=true; 1296 for V8:=0 to 7 do 1297 begin 1298 Loc1:=Adjacent[V8]; 1299 if Loc1>=0 then 1300 begin 1301 ok:=false; 1302 case CheckStep(MoveStyle, Time0, V8 and 1, ArriveTime, RecoverTurns, 1303 Map[Loc0], Map[Loc1],false) of 1304 csOk: ok:=true; 1305 csForbiddenTile: 1306 ;// !!! don't check moving there again 1307 csCheckTerritory: 1308 ok:= RO.Territory[Loc1]=RO.Territory[Loc0]; 1309 end; 1310 if ok and Pile.TestPut(Loc1, ArriveTime) then 1311 if ArriveTime<$2000 then Pile.Put(Loc1, ArriveTime) 1312 else IsComplete:=false 1313 end 1314 end; 1315 if IsComplete then 1316 Arrived[Loc0]:=(Arrived[Loc0] or CompleteFlag) and not NotReachedFlag; 1317 until false; 1318 end; 1319 1320 inc(TurnCount); 1321 end; 1322 Pile.Free; 1323 1324 if BestLoadLoc>=0 then 1325 begin 1326 TransportPlan.LoadLoc:=BestLoadLoc; 1327 TransportPlan.uixTransport:=ResponsibleTransport[BestLoadLoc]; 1328 TransportAvailable[TransportPlan.uixTransport]:=0; 1329 TransportPlan.TurnsEmpty:=BestTotalDelay-TurnsAfterLoad[BestLoadLoc]; 1330 TransportPlan.TurnsLoaded:=TurnsAfterLoad[BestLoadLoc]; 1331 TransportPlan.nLoad:=0; 1332 for tuix:=nSelectedLoad-1 downto 0 do 1333 if 1 shl (2*tuix) and Arrived[BestLoadLoc]=0 then 1334 begin 1335 assert(uixTransportLoad[tuixSelectedLoad[tuix]]=uixSelectedLoad[tuix]); 1336 TransportPlan.uixLoad[TransportPlan.nLoad]:=uixSelectedLoad[tuix]; 1337 uixTransportLoad[tuixSelectedLoad[tuix]]:= 1338 uixTransportLoad[nTransportLoad-1]; 1339 dec(nTransportLoad); 1340 inc(TransportPlan.nLoad) 1341 end; 1342 result:=true; 1343 exit 1344 end; 1345 1346 // no loading location for a single of these units -- remove all 1347 // should be pretty rare case 1348 for tuix:=nSelectedLoad-1 downto 0 do 1349 begin 1350 assert(uixTransportLoad[tuixSelectedLoad[tuix]]=uixSelectedLoad[tuix]); 1351 uixTransportLoad[tuixSelectedLoad[tuix]]:= 1352 uixTransportLoad[nTransportLoad-1]; 1353 dec(nTransportLoad); 1354 end; 1355 end; 1356 TransportPlan.LoadLoc:=-1; 1357 result:=false; 1456 Result := True; 1457 exit; 1458 end; 1459 1460 // no loading location for a single of these units -- remove all 1461 // should be pretty rare case 1462 for tuix := nSelectedLoad - 1 downto 0 do 1463 begin 1464 assert(uixTransportLoad[tuixSelectedLoad[tuix]] = uixSelectedLoad[tuix]); 1465 uixTransportLoad[tuixSelectedLoad[tuix]] := 1466 uixTransportLoad[nTransportLoad - 1]; 1467 Dec(nTransportLoad); 1468 end; 1469 end; 1470 TransportPlan.LoadLoc := -1; 1471 Result := False; 1358 1472 end; 1359 1473 … … 1364 1478 function TToolAI.CurrentMStrength(Domain: integer): integer; 1365 1479 var 1366 i: integer; 1367 begin 1368 result:=0; 1369 for i:=0 to nUpgrade-1 do with upgrade[Domain,i] do 1370 if (Preq=preNone) 1371 or (Preq>=0) and ((RO.Tech[Preq]>=tsApplicable) 1372 or (Preq in FutureTech) and (RO.Tech[Preq]>=0)) then 1373 begin 1374 if Preq in FutureTech then 1375 inc(result,RO.Tech[Preq]*Strength) 1376 else inc(result,Strength); 1377 end; 1480 i: integer; 1481 begin 1482 Result := 0; 1483 for i := 0 to nUpgrade - 1 do 1484 with upgrade[Domain, i] do 1485 if (Preq = preNone) or (Preq >= 0) and 1486 ((RO.Tech[Preq] >= tsApplicable) or (Preq in FutureTech) and 1487 (RO.Tech[Preq] >= 0)) then 1488 begin 1489 if Preq in FutureTech then 1490 Inc(Result, RO.Tech[Preq] * Strength) 1491 else 1492 Inc(Result, Strength); 1493 end; 1378 1494 end; 1379 1495 … … 1383 1499 procedure SetAdvancedness; 1384 1500 var 1385 ad,j,Reduction,AgeThreshold: integer; 1386 known: array[0..nAdv-1] of integer; 1501 ad, j, Reduction, AgeThreshold: integer; 1502 known: array[0..nAdv - 1] of integer; 1503 1387 1504 procedure MarkPreqs(ad: integer); 1388 1505 var 1389 i: integer;1506 i: integer; 1390 1507 begin 1391 if known[ad]=0 then 1392 begin 1393 known[ad]:=1; 1394 for i:=0 to 2 do 1395 if AdvPreq[ad,i]>=0 then MarkPreqs(AdvPreq[ad,i]); 1396 end 1397 end; 1398 begin 1399 FillChar(Advancedness,SizeOf(Advancedness),0); 1400 for ad:=0 to nAdv-1 do 1508 if known[ad] = 0 then 1509 begin 1510 known[ad] := 1; 1511 for i := 0 to 2 do 1512 if AdvPreq[ad, i] >= 0 then 1513 MarkPreqs(AdvPreq[ad, i]); 1514 end; 1515 end; 1516 1517 begin 1518 FillChar(Advancedness, SizeOf(Advancedness), 0); 1519 for ad := 0 to nAdv - 1 do 1401 1520 begin 1402 FillChar(known,SizeOf(known),0); 1403 MarkPreqs(ad); 1404 for j:=0 to nAdv-1 do if known[j]>0 then inc(Advancedness[ad]); 1405 end; 1406 AgeThreshold:=Advancedness[adScience]; 1407 Reduction:=Advancedness[adScience] div 3; 1408 for ad:=0 to nAdv-5 do 1409 if Advancedness[ad]>=AgeThreshold then 1410 dec(Advancedness[ad], Reduction); 1411 AgeThreshold:=Advancedness[adMassProduction]; 1412 Reduction:=(Advancedness[adMassProduction]-Advancedness[adScience]) div 3; 1413 for ad:=0 to nAdv-5 do 1414 if Advancedness[ad]>=AgeThreshold then 1415 dec(Advancedness[ad], Reduction) 1521 FillChar(known, SizeOf(known), 0); 1522 MarkPreqs(ad); 1523 for j := 0 to nAdv - 1 do 1524 if known[j] > 0 then 1525 Inc(Advancedness[ad]); 1526 end; 1527 AgeThreshold := Advancedness[adScience]; 1528 Reduction := Advancedness[adScience] div 3; 1529 for ad := 0 to nAdv - 5 do 1530 if Advancedness[ad] >= AgeThreshold then 1531 Dec(Advancedness[ad], Reduction); 1532 AgeThreshold := Advancedness[adMassProduction]; 1533 Reduction := (Advancedness[adMassProduction] - Advancedness[adScience]) div 3; 1534 for ad := 0 to nAdv - 5 do 1535 if Advancedness[ad] >= AgeThreshold then 1536 Dec(Advancedness[ad], Reduction); 1416 1537 end; 1417 1538 1418 1539 1419 1540 initialization 1420 SetAdvancedness;1541 SetAdvancedness; 1421 1542 1422 1543 end. 1423 -
branches/highdpi/CmdList.pas
r210 r303 57 57 constructor TCmdList.Create; 58 58 begin 59 inherited Create;59 inherited; 60 60 FState.nLog := 0; 61 61 LogAlloc := 0; … … 69 69 begin 70 70 ReallocMem(LogData, 0); 71 inherited Destroy;71 inherited; 72 72 end; 73 73 -
branches/highdpi/Database.pas
r246 r303 1082 1082 else 1083 1083 result := 0; 1084 Q.Free;1084 FreeAndNil(Q); 1085 1085 end; 1086 1086 -
branches/highdpi/Direct.pas
r252 r303 30 30 procedure SetInfo(x: string); 31 31 procedure SetState(x: integer); 32 procedure OnGo(var Msg: TMessage); message WM_GO;33 procedure OnChangeClient(var Msg: TMessage); message WM_CHANGECLIENT;34 procedure OnNextPlayer(var Msg: TMessage); message WM_NEXTPLAYER;32 procedure OnGo(var m: TMessage); message WM_GO; 33 procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT; 34 procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER; 35 35 procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION; 36 36 end; … … 208 208 end; 209 209 210 procedure TDirectDlg.OnGo(var Msg: TMessage);210 procedure TDirectDlg.OnGo(var m: TMessage); 211 211 var 212 212 i: integer; … … 234 234 Quick := true; 235 235 DirectHelp(cHelpOnly); 236 Close ;236 Close 237 237 end; 238 238 end … … 254 254 end; 255 255 256 procedure TDirectDlg.OnChangeClient(var Msg: TMessage);256 procedure TDirectDlg.OnChangeClient(var m: TMessage); 257 257 begin 258 258 ChangeClient; 259 259 end; 260 260 261 procedure TDirectDlg.OnNextPlayer(var Msg: TMessage);261 procedure TDirectDlg.OnNextPlayer(var m: TMessage); 262 262 begin 263 263 NextPlayer; -
branches/highdpi/GameServer.pas
r266 r303 7 7 8 8 uses 9 UDpiControls, Protocol, Database, dynlibs, Platform, dateutils, fgl, LazFileUtils, Graphics; 9 UDpiControls, Protocol, Database, dynlibs, Platform, dateutils, fgl, LazFileUtils, 10 Graphics; 10 11 11 12 const 12 Version = $010 200;13 Version = $010300; 13 14 FirstAICompatibleVersion = $000D00; 14 15 FirstBookCompatibleVersion = $010103; … … 561 562 MapFile := TFileStream.Create(GetMapsDir + DirectorySeparator + FileName, 562 563 fmCreate or fmShareExclusive); 563 MapFile.Position := 0; 564 s := 'cEvoMap'#0; 565 MapFile.write(s[1], 8); { file id } 566 i := 0; 567 MapFile.write(i, 4); { format id } 568 MapFile.write(MaxTurn, 4); 569 MapFile.write(lx, 4); 570 MapFile.write(ly, 4); 571 MapFile.write(RealMap, MapSize * 4); 572 MapFile.Free; 564 try 565 MapFile.Position := 0; 566 s := 'cEvoMap'#0; 567 MapFile.write(s[1], 8); { file id } 568 i := 0; 569 MapFile.write(i, 4); { format id } 570 MapFile.write(MaxTurn, 4); 571 MapFile.write(lx, 4); 572 MapFile.write(ly, 4); 573 MapFile.write(RealMap, MapSize * 4); 574 finally 575 FreeAndNil(MapFile); 576 end; 573 577 end; 574 578 … … 613 617 result := true; 614 618 end; 615 MapFile.Free;619 FreeAndNil(MapFile); 616 620 except 617 621 if MapFile <> nil then 618 MapFile.Free;622 FreeAndNil(MapFile); 619 623 end; 620 624 end; … … 694 698 else 695 699 CL.SaveToFile(LogFile); 696 LogFile.Free;700 FreeAndNil(LogFile); 697 701 if auto then 698 702 begin … … 721 725 Brains.GetByKind(btAI, AIBrains); 722 726 bix[p1] := AIBrains[DelphiRandom(AIBrains.Count)]; 723 AIBrains.Free;727 FreeAndNil(AIBrains); 724 728 end 725 729 else … … 863 867 Human := 0; 864 868 for p1 := 0 to nPl - 1 do 865 if bix[p1].Kind = btTermthen869 if Assigned(bix[p1]) and (bix[p1].Kind = btTerm) then 866 870 inc(Human, 1 shl p1); 867 871 InitMapGame(Human); … … 992 996 CityProcessing.ReleaseGame; 993 997 Database.ReleaseGame; 994 CL.Free;998 FreeAndNil(CL); 995 999 end; 996 1000 … … 1190 1194 CL.LoadFromFile(LogFile); 1191 1195 end; 1192 LogFile.Free;1196 FreeAndNil(LogFile); 1193 1197 if not result then 1194 1198 Exit; … … 4604 4608 begin 4605 4609 FreeAndNil(Picture); 4606 inherited Destroy;4610 inherited; 4607 4611 end; 4608 4612 -
branches/highdpi/Global.pas
r210 r303 6 6 CevoExt = '.cevo'; 7 7 CevoMapExt = '.cevo map'; 8 CevoHomepage = 'http://c-evo.org'; 9 CevoContact = 'http://c-evo.org/_sg/contact'; 10 CevoContactBug = 'http://c-evo.org/_sg/contact/cevobug.html'; 8 CevoTribeExt = '.tribe.txt'; 9 CevoHomepage = 'https://app.zdechov.net/c-evo'; 10 CevoContact = 'https://app.zdechov.net/c-evo#Contact'; 11 CevoContactBug = 'https://app.zdechov.net/c-evo/report/1'; 11 12 AppRegistryKey = '\SOFTWARE\C-evo'; 12 13 AITemplateFileName = 'AI Template' + DirectorySeparator + 'AI development manual.html'; 14 13 15 14 16 implementation -
branches/highdpi/IPQ.pas
r210 r303 47 47 GetMem(Ix, fmax * sizeof(integer)); 48 48 n := -1; 49 Empty 49 Empty; 50 50 end; 51 51 … … 54 54 FreeMem(bh); 55 55 FreeMem(Ix); 56 inherited Destroy;56 inherited; 57 57 end; 58 58 -
branches/highdpi/Install/deb/debian/compat
r55 r303 1 8 1 10 -
branches/highdpi/Install/deb/debian/install
r246 r303 11 11 Maps usr/share/c-evo 12 12 Saved usr/share/c-evo 13 AI?Template usr/share/c-evo 13 14 14 15 AI/StdAI/StdAI.ai.txt usr/share/c-evo/AI/StdAI -
branches/highdpi/Integrated.lpi
r247 r303 102 102 </Item3> 103 103 </RequiredPackages> 104 <Units Count="4 1">104 <Units Count="42"> 105 105 <Unit0> 106 106 <Filename Value="Integrated.lpr"/> … … 325 325 </Unit37> 326 326 <Unit38> 327 <Filename Value=" Locale.pas"/>328 <IsPartOfProject Value="True"/> 329 <ComponentName Value=" LocaleDlg"/>327 <Filename Value="Settings.pas"/> 328 <IsPartOfProject Value="True"/> 329 <ComponentName Value="SettingsDlg"/> 330 330 <HasResources Value="True"/> 331 331 <ResourceBaseClass Value="Form"/> … … 339 339 <IsPartOfProject Value="True"/> 340 340 </Unit40> 341 <Unit41> 342 <Filename Value="LocalPlayer\UKeyBindings.pas"/> 343 <IsPartOfProject Value="True"/> 344 </Unit41> 341 345 </Units> 342 346 </ProjectOptions> -
branches/highdpi/LocalPlayer/CityScreen.pas
r246 r303 216 216 Template := TDpiBitmap.Create; 217 217 Template.PixelFormat := pf24bit; 218 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'City.png', gfNoGamma); 218 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'City.png', 219 [gfNoGamma]); 219 220 CityMapTemplate := TDpiBitmap.Create; 220 221 CityMapTemplate.PixelFormat := pf24bit; 221 LoadGraphicFile(CityMapTemplate, GetGraphicsDir + DirectorySeparator + 'BigCityMap.png', gfNoGamma); 222 LoadGraphicFile(CityMapTemplate, GetGraphicsDir + DirectorySeparator + 'BigCityMap.png', 223 [gfNoGamma]); 222 224 SmallCityMapTemplate := TDpiBitmap.Create; 223 225 SmallCityMapTemplate.PixelFormat := pf24bit; 224 226 LoadGraphicFile(SmallCityMapTemplate, GetGraphicsDir + DirectorySeparator + 'SmallCityMap.png', 225 gfNoGamma);227 [gfNoGamma]); 226 228 SmallCityMap := TDpiBitmap.Create; 227 229 SmallCityMap.PixelFormat := pf24bit; … … 1397 1399 1398 1400 procedure TCityDlg.ChooseProject; 1399 const 1400 ptSelect = 0; 1401 ptTrGoods = 1; 1402 ptUn = 2; 1403 ptCaravan = 3; 1404 ptImp = 4; 1405 ptWonder = 6; 1406 ptShip = 7; 1407 ptInvalid = 8; 1408 1409 function ProjectType(Project: integer): integer; 1401 type 1402 TProjectType = ( 1403 ptSelect = 0, 1404 ptTrGoods = 1, 1405 ptUn = 2, 1406 ptCaravan = 3, 1407 ptImp = 4, 1408 ptWonder = 6, 1409 ptShip = 7, 1410 ptInvalid = 8 1411 ); 1412 1413 function ProjectType(Project: integer): TProjectType; 1410 1414 begin 1411 1415 if Project and cpCompleted <> 0 then 1412 result := ptSelect1416 Result := ptSelect 1413 1417 else if Project and (cpImp + cpIndex) = cpImp + imTrGoods then 1414 result := ptTrGoods1415 else if Project and cpImp = 0 then 1418 Result := ptTrGoods 1419 else if Project and cpImp = 0 then begin 1416 1420 if MyModel[Project and cpIndex].Kind = mkCaravan then 1417 result := ptCaravan1418 else 1419 result := ptUn1421 Result := ptCaravan 1422 else Result := ptUn; 1423 end 1420 1424 else if Project and cpIndex >= nImp then 1421 result := ptInvalid1425 Result := ptInvalid 1422 1426 else if Imp[Project and cpIndex].Kind = ikWonder then 1423 result := ptWonder1427 Result := ptWonder 1424 1428 else if Imp[Project and cpIndex].Kind = ikShipPart then 1425 result := ptShip1426 else 1427 result := ptImp1429 Result := ptShip 1430 else 1431 Result := ptImp; 1428 1432 end; 1429 1433 1430 1434 var 1431 NewProject, OldMoney, pt0, pt1, cix1: integer; 1435 NewProject, OldMoney, cix1: integer; 1436 pt0, pt1: TProjectType; 1432 1437 QueryOk: boolean; 1433 1438 begin 1434 assert(not supervising);1439 Assert(not supervising); 1435 1440 ModalSelectDlg.ShowNewContent_CityProject(wmModal, cix); 1436 1441 if ModalSelectDlg.result <> -1 then … … 1444 1449 else 1445 1450 begin 1446 NewProject := ModalSelectDlg. result;1447 QueryOk := true;1451 NewProject := ModalSelectDlg.Result; 1452 QueryOk := True; 1448 1453 if (NewProject and cpImp <> 0) and (NewProject and cpIndex >= 28) and 1449 1454 (MyRO.NatBuilt[NewProject and cpIndex] > 0) then … … 1453 1458 while (cix1 >= 0) and 1454 1459 (MyCity[cix1].Built[NewProject and cpIndex] = 0) do 1455 dec(cix1);1460 Dec(cix1); 1456 1461 MessgText := Format(Phrases.Lookup('DOUBLESTATEIMP'), 1457 1462 [Phrases.Lookup('IMPROVEMENTS', NewProject and cpIndex), … … 1465 1470 end; 1466 1471 if not QueryOk then 1467 exit;1472 Exit; 1468 1473 1469 1474 if (MyCity[cix].Prod > 0) then … … 1476 1481 (cpImp or cpIndex) then 1477 1482 begin // loss of material -- do query 1483 DpiApplication.ProcessMessages; // TODO: Needed for Gtk2, Lazarus gtk2 bug? 1478 1484 if (pt1 = ptTrGoods) or (pt1 = ptShip) or (pt1 <> pt0) and 1479 (pt0 <> ptCaravan) then 1485 (pt0 <> ptCaravan) then begin 1480 1486 QueryOk := SimpleQuery(mkOkCancel, 1481 1487 Format(Phrases.Lookup('LOSEMAT'), [MyCity[cix].Prod0, 1482 1488 MyCity[cix].Prod0]), 'MSG_DEFAULT') = mrOK 1483 else if MyCity[cix].Project and (cpImp or cpIndex) = MyCity[cix] 1484 .Project0 and (cpImp or cpIndex) then 1485 QueryOk := SimpleQuery(mkOkCancel, Phrases.Lookup('LOSEMAT3'), 1486 'MSG_DEFAULT') = mrOK 1489 end else 1490 if MyCity[cix].Project and (cpImp or cpIndex) = MyCity[cix] 1491 .Project0 and (cpImp or cpIndex) then begin 1492 QueryOk := SimpleQuery(mkOkCancel, Phrases.Lookup('LOSEMAT3'), 1493 'MSG_DEFAULT') = mrOK; 1494 end; 1487 1495 end; 1488 1496 end; 1489 1497 end; 1490 1498 if not QueryOk then 1491 exit;1499 Exit; 1492 1500 1493 1501 OldMoney := MyRO.Money; -
branches/highdpi/LocalPlayer/ClientTools.pas
r210 r303 13 13 14 14 type 15 TImpOrder = array [0 .. (nImp + 4) div 4 * 4 - 1] of ShortInt;16 TEnhancementJobs = array [0 .. 11, 0 .. 7] of Byte;15 TImpOrder = array [0 .. (nImp + 4) div 4 * 4 - 1] of shortint; 16 TEnhancementJobs = array [0 .. 11, 0 .. 7] of byte; 17 17 JobResultSet = set of 0 .. 39; 18 18 … … 42 42 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 43 43 gov, size: integer): integer; 44 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew) 45 : integer; 44 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew): integer; 46 45 procedure SumCities(var TaxSum, ScienceSum: integer); 47 46 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet = []): boolean; … … 50 49 function UnitExhausted(uix: integer): boolean; 51 50 function ModelHash(const ModelInfo: TModelInfo): integer; 52 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs) 53 : integer; 51 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs): integer; 54 52 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 55 53 procedure DebugMessage(Level: integer; Text: string); … … 62 60 procedure CityOptimizer_EndOfTurn; 63 61 62 64 63 implementation 65 64 … … 72 71 begin 73 72 y0 := (Loc + G.lx * 1024) div G.lx - 1024; 74 result := (Loc + (dx + y0 and 1 + G.lx * 1024) shr 1) mod G.lx + G.lx 75 * (y0 + dy) 73 Result := (Loc + (dx + y0 and 1 + G.lx * 1024) shr 1) mod G.lx + G.lx * (y0 + dy); 76 74 end; 77 75 … … 80 78 dx, dy: integer; 81 79 begin 82 inc(Loc0, G.lx * 1024);83 inc(Loc1, G.lx * 1024);84 dx := abs(((Loc1 mod G.lx * 2 + Loc1 div G.lx and 1) - (Loc0 mod G.lx * 2 +85 Loc0 div G.lx and 1) + 3 * G.lx) mod (2 * G.lx) - G.lx);80 Inc(Loc0, G.lx * 1024); 81 Inc(Loc1, G.lx * 1024); 82 dx := abs(((Loc1 mod G.lx * 2 + Loc1 div G.lx and 1) - 83 (Loc0 mod G.lx * 2 + Loc0 div G.lx and 1) + 3 * G.lx) mod (2 * G.lx) - G.lx); 86 84 dy := abs(Loc1 div G.lx - Loc0 div G.lx); 87 result := dx + dy + abs(dx - dy) shr 1;85 Result := dx + dy + abs(dx - dy) shr 1; 88 86 end; 89 87 … … 92 90 uix1: integer; 93 91 begin 94 result := false;92 Result := False; 95 93 if MyModel[MyUn[uix].mix].Flags and mdCivil = 0 then 96 94 case MyRO.Government of 97 95 gRepublic, gFuture: 98 result := (MyRO.Territory[Loc] >= 0) and (MyRO.Territory[Loc] <> me) and96 Result := (MyRO.Territory[Loc] >= 0) and (MyRO.Territory[Loc] <> me) and 99 97 (MyRO.Treaty[MyRO.Territory[Loc]] < trAlliance); 100 98 gDemocracy: 101 result := (MyRO.Territory[Loc] < 0) or (MyRO.Territory[Loc] <> me) and99 Result := (MyRO.Territory[Loc] < 0) or (MyRO.Territory[Loc] <> me) and 102 100 (MyRO.Treaty[MyRO.Territory[Loc]] < trAlliance); 103 101 end; … … 106 104 for uix1 := 0 to MyRO.nUn - 1 do // check transported units too 107 105 if (MyUn[uix1].Loc >= 0) and (MyUn[uix1].Master = uix) then 108 result := result or UnrestAtLoc(uix1, Loc);106 Result := Result or UnrestAtLoc(uix1, Loc); 109 107 end; 110 108 … … 124 122 MoveAdviceData.MoreTurns := 999; 125 123 MoveAdviceData.MaxHostile_MovementLeft := MyUn[uix].Health - MinEndHealth; 126 result := Server(sGetMoveAdvice, me, uix, MoveAdviceData);127 if (MinEndHealth <= 1) or ( result <> eNoWay) then124 Result := Server(sGetMoveAdvice, me, uix, MoveAdviceData); 125 if (MinEndHealth <= 1) or (Result <> eNoWay) then 128 126 exit; 129 127 end; … … 135 133 25: 136 134 MinEndHealth := 12; 135 else 136 MinEndHealth := 1 137 end; 138 until False; 139 end; 140 141 function ColorOfHealth(Health: integer): integer; 142 var 143 red, green: integer; 144 begin 145 green := 400 * Health div 100; 146 if green > 200 then 147 green := 200; 148 red := 510 * (100 - Health) div 100; 149 if red > 255 then 150 red := 255; 151 Result := green shl 8 + red; 152 end; 153 154 function IsMultiPlayerGame: boolean; 155 var 156 p1: integer; 157 begin 158 Result := False; 159 for p1 := 1 to nPl - 1 do 160 if G.RO[p1] <> nil then 161 Result := True; 162 end; 163 164 procedure ItsMeAgain(p: integer); 165 begin 166 if G.RO[p] <> nil then 167 MyRO := pointer(G.RO[p]) 168 else if G.SuperVisorRO[p] <> nil then 169 MyRO := pointer(G.SuperVisorRO[p]) 170 else 171 exit; 172 me := p; 173 MyMap := pointer(MyRO.Map); 174 MyUn := pointer(MyRO.Un); 175 MyCity := pointer(MyRO.City); 176 MyModel := pointer(MyRO.Model); 177 end; 178 179 function GetAge(p: integer): integer; 180 var 181 i: integer; 182 begin 183 if p = me then 184 begin 185 Result := 0; 186 for i := 1 to 3 do 187 if MyRO.Tech[AgePreq[i]] >= tsApplicable then 188 Result := i; 189 end 190 else 191 begin 192 Result := 0; 193 for i := 1 to 3 do 194 if MyRO.EnemyReport[p].Tech[AgePreq[i]] >= tsApplicable then 195 Result := i; 196 end; 197 end; 198 199 function IsCivilReportNew(Enemy: integer): boolean; 200 var 201 i: integer; 202 begin 203 assert(Enemy <> me); 204 i := MyRO.EnemyReport[Enemy].TurnOfCivilReport; 205 Result := (i = MyRO.Turn) or (i = MyRO.Turn - 1) and (Enemy > me); 206 end; 207 208 function IsMilReportNew(Enemy: integer): boolean; 209 var 210 i: integer; 211 begin 212 assert(Enemy <> me); 213 i := MyRO.EnemyReport[Enemy].TurnOfMilReport; 214 Result := (i = MyRO.Turn) or (i = MyRO.Turn - 1) and (Enemy > me); 215 end; 216 217 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 218 gov, size: integer): integer; 219 begin 220 Result := FoodSurplus; 221 if not IsCityAlive or (Result > 0) and ((gov = gFuture) or 222 (size >= NeedAqueductSize) and (Result < 2)) then 223 Result := 0; { no growth } 224 end; 225 226 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew): integer; 227 var 228 i: integer; 229 begin 230 Result := 0; 231 if (CityReport.HappinessBalance >= 0) { no disorder } and 232 (MyCity[cix].Flags and chCaptured = 0) then // not captured 233 begin 234 Inc(Result, CityReport.Tax); 235 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) and 236 (CityReport.Production > 0) then 237 Inc(Result, CityReport.Production); 238 if ((MyRO.Government = gFuture) or (MyCity[cix].size >= 239 NeedAqueductSize) and (CityReport.FoodSurplus < 2)) and 240 (CityReport.FoodSurplus > 0) then 241 Inc(Result, CityReport.FoodSurplus); 242 end; 243 for i := 28 to nImp - 1 do 244 if MyCity[cix].Built[i] > 0 then 245 Dec(Result, Imp[i].Maint); 246 end; 247 248 procedure SumCities(var TaxSum, ScienceSum: integer); 249 var 250 cix: integer; 251 CityReport: TCityReportNew; 252 begin 253 TaxSum := MyRO.OracleIncome; 254 ScienceSum := 0; 255 if MyRO.Government = gAnarchy then 256 exit; 257 for cix := 0 to MyRO.nCity - 1 do 258 if MyCity[cix].Loc >= 0 then 259 begin 260 CityReport.HypoTiles := -1; 261 CityReport.HypoTaxRate := -1; 262 CityReport.HypoLuxuryRate := -1; 263 Server(sGetCityReportNew, me, cix, CityReport); 264 if (CityReport.HappinessBalance >= 0) { no disorder } and 265 (MyCity[cix].Flags and chCaptured = 0) then // not captured 266 ScienceSum := ScienceSum + CityReport.Science; 267 TaxSum := TaxSum + CityTaxBalance(cix, CityReport); 268 end; 269 end; 270 271 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet): boolean; 272 var 273 Test: integer; 274 begin 275 Test := Server(sStartJob + Job shl 4 - sExecute, me, uix, nil^); 276 Result := (Test >= rExecuted) or (Test in IgnoreResults); 277 end; 278 279 procedure GetUnitInfo(Loc: integer; var uix: integer; var UnitInfo: TUnitInfo); 280 var 281 i, Cnt: integer; 282 begin 283 if MyMap[Loc] and fOwned <> 0 then 284 begin 285 Server(sGetDefender, me, Loc, uix); 286 Cnt := 0; 287 for i := 0 to MyRO.nUn - 1 do 288 if MyUn[i].Loc = Loc then 289 Inc(Cnt); 290 MakeUnitInfo(me, MyUn[uix], UnitInfo); 291 if Cnt > 1 then 292 UnitInfo.Flags := UnitInfo.Flags or unMulti; 293 end 294 else 295 begin 296 uix := MyRO.nEnemyUn - 1; 297 while (uix >= 0) and (MyRO.EnemyUn[uix].Loc <> Loc) do 298 Dec(uix); 299 UnitInfo := MyRO.EnemyUn[uix]; 300 end; 301 end; { GetUnitInfo } 302 303 procedure GetCityInfo(Loc: integer; var cix: integer; var CityInfo: TCityInfo); 304 begin 305 if MyMap[Loc] and fOwned <> 0 then 306 begin 307 CityInfo.Loc := Loc; 308 cix := MyRO.nCity - 1; 309 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 310 Dec(cix); 311 with CityInfo do 312 begin 313 Owner := me; 314 ID := MyCity[cix].ID; 315 size := MyCity[cix].size; 316 Flags := 0; 317 if MyCity[cix].Built[imPalace] > 0 then 318 Inc(Flags, ciCapital); 319 if (MyCity[cix].Built[imWalls] > 0) or 320 (MyMap[MyCity[cix].Loc] and fGrWall <> 0) then 321 Inc(Flags, ciWalled); 322 if MyCity[cix].Built[imCoastalFort] > 0 then 323 Inc(Flags, ciCoastalFort); 324 if MyCity[cix].Built[imMissileBat] > 0 then 325 Inc(Flags, ciMissileBat); 326 if MyCity[cix].Built[imBunker] > 0 then 327 Inc(Flags, ciBunker); 328 if MyCity[cix].Built[imSpacePort] > 0 then 329 Inc(Flags, ciSpacePort); 330 end; 331 end 332 else 333 begin 334 cix := MyRO.nEnemyCity - 1; 335 while (cix >= 0) and (MyRO.EnemyCity[cix].Loc <> Loc) do 336 Dec(cix); 337 CityInfo := MyRO.EnemyCity[cix]; 338 end; 339 end; 340 341 function UnitExhausted(uix: integer): boolean; 342 // check if another move of this unit is still possible 343 var 344 dx, dy: integer; 345 begin 346 Result := True; 347 if (MyUn[uix].Movement > 0) or 348 (MyRO.Wonder[woShinkansen].EffectiveOwner = me) then 349 if (MyUn[uix].Movement >= 100) or 350 ((MyModel[MyUn[uix].mix].Kind = mkCaravan) and 351 (MyMap[MyUn[uix].Loc] and fCity <> 0)) then 352 Result := False 137 353 else 138 MinEndHealth := 1 139 end; 140 until false end; 141 142 function ColorOfHealth(Health: integer): integer; 143 var 144 red, green: integer; 145 begin 146 green := 400 * Health div 100; 147 if green > 200 then 148 green := 200; 149 red := 510 * (100 - Health) div 100; 150 if red > 255 then 151 red := 255; 152 result := green shl 8 + red 153 end; 154 155 function IsMultiPlayerGame: boolean; 156 var 157 p1: integer; 158 begin 159 result := false; 160 for p1 := 1 to nPl - 1 do 161 if G.RO[p1] <> nil then 162 result := true; 163 end; 164 165 procedure ItsMeAgain(p: integer); 166 begin 167 if G.RO[p] <> nil then 168 MyRO := pointer(G.RO[p]) 169 else if G.SuperVisorRO[p] <> nil then 170 MyRO := pointer(G.SuperVisorRO[p]) 171 else 172 exit; 173 me := p; 174 MyMap := pointer(MyRO.Map); 175 MyUn := pointer(MyRO.Un); 176 MyCity := pointer(MyRO.City); 177 MyModel := pointer(MyRO.Model); 178 end; 179 180 function GetAge(p: integer): integer; 181 var 182 i: integer; 183 begin 184 if p = me then 185 begin 186 result := 0; 187 for i := 1 to 3 do 188 if MyRO.Tech[AgePreq[i]] >= tsApplicable then 189 result := i; 190 end 354 for dx := -2 to 2 do 355 for dy := -2 to 2 do 356 if abs(dx) + abs(dy) = 2 then 357 if Server(sMoveUnit - sExecute + dx and 7 shl 4 + dy and 358 7 shl 7, me, uix, nil^) >= rExecuted then 359 Result := False; 360 end; 361 362 function ModelHash(const ModelInfo: TModelInfo): integer; 363 var 364 i, FeatureCode, Hash1, Hash2, Hash2r, d: cardinal; 365 begin 366 with ModelInfo do 367 if Kind > mkEnemyDeveloped then 368 Result := integer($C0000000 + Speed div 50 + Kind shl 8) 191 369 else 192 370 begin 193 result := 0; 194 for i := 1 to 3 do 195 if MyRO.EnemyReport[p].Tech[AgePreq[i]] >= tsApplicable then 196 result := i; 197 end 198 end; 199 200 function IsCivilReportNew(Enemy: integer): boolean; 201 var 202 i: integer; 203 begin 204 assert(Enemy <> me); 205 i := MyRO.EnemyReport[Enemy].TurnOfCivilReport; 206 result := (i = MyRO.Turn) or (i = MyRO.Turn - 1) and (Enemy > me); 207 end; 208 209 function IsMilReportNew(Enemy: integer): boolean; 210 var 211 i: integer; 212 begin 213 assert(Enemy <> me); 214 i := MyRO.EnemyReport[Enemy].TurnOfMilReport; 215 result := (i = MyRO.Turn) or (i = MyRO.Turn - 1) and (Enemy > me); 216 end; 217 218 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 219 gov, size: integer): integer; 220 begin 221 result := FoodSurplus; 222 if not IsCityAlive or (result > 0) and 223 ((gov = gFuture) or (size >= NeedAqueductSize) and (result < 2)) then 224 result := 0; { no growth } 225 end; 226 227 function CityTaxBalance(cix: integer; 228 const CityReport: TCityReportNew): integer; 229 var 230 i: integer; 231 begin 232 result := 0; 233 if (CityReport.HappinessBalance >= 0) { no disorder } 234 and (MyCity[cix].Flags and chCaptured = 0) then // not captured 235 begin 236 inc(result, CityReport.Tax); 237 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) and 238 (CityReport.Production > 0) then 239 inc(result, CityReport.Production); 240 if ((MyRO.Government = gFuture) or (MyCity[cix].size >= NeedAqueductSize) 241 and (CityReport.FoodSurplus < 2)) and (CityReport.FoodSurplus > 0) then 242 inc(result, CityReport.FoodSurplus); 371 FeatureCode := 0; 372 for i := mcFirstNonCap to nFeature - 1 do 373 if 1 shl Domain and Feature[i].Domains <> 0 then 374 begin 375 FeatureCode := FeatureCode * 2; 376 if 1 shl (i - mcFirstNonCap) <> 0 then 377 Inc(FeatureCode); 378 end; 379 case Domain of 380 dGround: 381 begin 382 assert(FeatureCode < 1 shl 8); 383 assert(Attack < 5113); 384 assert(Defense < 2273); 385 assert(Cost < 1611); 386 Hash1 := (Attack * 2273 + Defense) * 9 + (Speed - 150) div 50; 387 Hash2 := FeatureCode * 1611 + Cost; 388 end; 389 dSea: 390 begin 391 assert(FeatureCode < 1 shl 9); 392 assert(Attack < 12193); 393 assert(Defense < 6097); 394 assert(Cost < 4381); 395 Hash1 := ((Attack * 6097 + Defense) * 5 + 396 (Speed - 350) div 100) * 2; 397 if Weight >= 6 then 398 Inc(Hash1); 399 Hash2 := ((TTrans * 17 + ATrans_Fuel) shl 9 + FeatureCode) * 400 4381 + Cost; 401 end; 402 dAir: 403 begin 404 assert(FeatureCode < 1 shl 5); 405 assert(Attack < 2407); 406 assert(Defense < 1605); 407 assert(Bombs < 4813); 408 assert(Cost < 2089); 409 Hash1 := (Attack * 1605 + Defense) shl 5 + FeatureCode; 410 Hash2 := ((Bombs * 7 + ATrans_Fuel) * 4 + TTrans) * 2089 + Cost; 411 end; 412 end; 413 Hash2r := 0; 414 for i := 0 to 7 do 415 begin 416 Hash2r := Hash2r * 13; 417 d := Hash2 div 13; 418 Inc(Hash2r, Hash2 - d * 13); 419 Hash2 := d; 420 end; 421 Result := integer(Domain shl 30 + Hash1 xor Hash2r); 243 422 end; 244 for i := 28 to nImp - 1 do 245 if MyCity[cix].Built[i] > 0 then 246 dec(result, Imp[i].Maint); 247 end; 248 249 procedure SumCities(var TaxSum, ScienceSum: integer); 250 var 251 cix: integer; 252 CityReport: TCityReportNew; 253 begin 254 TaxSum := MyRO.OracleIncome; 255 ScienceSum := 0; 256 if MyRO.Government = gAnarchy then 257 exit; 258 for cix := 0 to MyRO.nCity - 1 do 259 if MyCity[cix].Loc >= 0 then 260 begin 261 CityReport.HypoTiles := -1; 262 CityReport.HypoTaxRate := -1; 263 CityReport.HypoLuxuryRate := -1; 264 Server(sGetCityReportNew, me, cix, CityReport); 265 if (CityReport.HappinessBalance >= 0) { no disorder } 266 and (MyCity[cix].Flags and chCaptured = 0) then // not captured 267 ScienceSum := ScienceSum + CityReport.Science; 268 TaxSum := TaxSum + CityTaxBalance(cix, CityReport); 269 end; 270 end; 271 272 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet): boolean; 273 var 274 Test: integer; 275 begin 276 Test := Server(sStartJob + Job shl 4 - sExecute, me, uix, nil^); 277 result := (Test >= rExecuted) or (Test in IgnoreResults); 278 end; 279 280 procedure GetUnitInfo(Loc: integer; var uix: integer; 281 var UnitInfo: TUnitInfo); 282 var 283 i, Cnt: integer; 284 begin 285 if MyMap[Loc] and fOwned <> 0 then 286 begin 287 Server(sGetDefender, me, Loc, uix); 288 Cnt := 0; 289 for i := 0 to MyRO.nUn - 1 do 290 if MyUn[i].Loc = Loc then 291 inc(Cnt); 292 MakeUnitInfo(me, MyUn[uix], UnitInfo); 293 if Cnt > 1 then 294 UnitInfo.Flags := UnitInfo.Flags or unMulti; 295 end 296 else 297 begin 298 uix := MyRO.nEnemyUn - 1; 299 while (uix >= 0) and (MyRO.EnemyUn[uix].Loc <> Loc) do 300 dec(uix); 301 UnitInfo := MyRO.EnemyUn[uix]; 302 end 303 end; { GetUnitInfo } 304 305 procedure GetCityInfo(Loc: integer; var cix: integer; 306 var CityInfo: TCityInfo); 307 begin 308 if MyMap[Loc] and fOwned <> 0 then 309 begin 310 CityInfo.Loc := Loc; 311 cix := MyRO.nCity - 1; 312 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 313 dec(cix); 314 with CityInfo do 315 begin 316 Owner := me; 317 ID := MyCity[cix].ID; 318 size := MyCity[cix].size; 319 Flags := 0; 320 if MyCity[cix].Built[imPalace] > 0 then 321 inc(Flags, ciCapital); 322 if (MyCity[cix].Built[imWalls] > 0) or 323 (MyMap[MyCity[cix].Loc] and fGrWall <> 0) then 324 inc(Flags, ciWalled); 325 if MyCity[cix].Built[imCoastalFort] > 0 then 326 inc(Flags, ciCoastalFort); 327 if MyCity[cix].Built[imMissileBat] > 0 then 328 inc(Flags, ciMissileBat); 329 if MyCity[cix].Built[imBunker] > 0 then 330 inc(Flags, ciBunker); 331 if MyCity[cix].Built[imSpacePort] > 0 then 332 inc(Flags, ciSpacePort); 333 end 334 end 335 else 336 begin 337 cix := MyRO.nEnemyCity - 1; 338 while (cix >= 0) and (MyRO.EnemyCity[cix].Loc <> Loc) do 339 dec(cix); 340 CityInfo := MyRO.EnemyCity[cix]; 341 end 342 end; 343 344 function UnitExhausted(uix: integer): boolean; 345 // check if another move of this unit is still possible 346 var 347 dx, dy: integer; 348 begin 349 result := true; 350 if (MyUn[uix].Movement > 0) or 351 (MyRO.Wonder[woShinkansen].EffectiveOwner = me) then 352 if (MyUn[uix].Movement >= 100) or 353 ((MyModel[MyUn[uix].mix].Kind = mkCaravan) and 354 (MyMap[MyUn[uix].Loc] and fCity <> 0)) then 355 result := false 356 else 357 for dx := -2 to 2 do 358 for dy := -2 to 2 do 359 if abs(dx) + abs(dy) = 2 then 360 if Server(sMoveUnit - sExecute + dx and 7 shl 4 + dy and 7 shl 7, 361 me, uix, nil^) >= rExecuted then 362 result := false; 363 end; 364 365 function ModelHash(const ModelInfo: TModelInfo): integer; 366 var 367 i, FeatureCode, Hash1, Hash2, Hash2r, d: cardinal; 368 begin 369 with ModelInfo do 370 if Kind > mkEnemyDeveloped then 371 result := integer($C0000000 + Speed div 50 + Kind shl 8) 372 else 373 begin 374 FeatureCode := 0; 375 for i := mcFirstNonCap to nFeature - 1 do 376 if 1 shl Domain and Feature[i].Domains <> 0 then 377 begin 378 FeatureCode := FeatureCode * 2; 379 if 1 shl (i - mcFirstNonCap) <> 0 then 380 inc(FeatureCode); 381 end; 382 case Domain of 383 dGround: 384 begin 385 assert(FeatureCode < 1 shl 8); 386 assert(Attack < 5113); 387 assert(Defense < 2273); 388 assert(Cost < 1611); 389 Hash1 := (Attack * 2273 + Defense) * 9 + (Speed - 150) div 50; 390 Hash2 := FeatureCode * 1611 + Cost; 391 end; 392 dSea: 393 begin 394 assert(FeatureCode < 1 shl 9); 395 assert(Attack < 12193); 396 assert(Defense < 6097); 397 assert(Cost < 4381); 398 Hash1 := ((Attack * 6097 + Defense) * 5 + (Speed - 350) 399 div 100) * 2; 400 if Weight >= 6 then 401 inc(Hash1); 402 Hash2 := ((TTrans * 17 + ATrans_Fuel) shl 9 + FeatureCode) * 403 4381 + Cost; 404 end; 405 dAir: 406 begin 407 assert(FeatureCode < 1 shl 5); 408 assert(Attack < 2407); 409 assert(Defense < 1605); 410 assert(Bombs < 4813); 411 assert(Cost < 2089); 412 Hash1 := (Attack * 1605 + Defense) shl 5 + FeatureCode; 413 Hash2 := ((Bombs * 7 + ATrans_Fuel) * 4 + TTrans) * 2089 + Cost; 414 end; 415 end; 416 Hash2r := 0; 417 for i := 0 to 7 do 418 begin 419 Hash2r := Hash2r * 13; 420 d := Hash2 div 13; 421 inc(Hash2r, Hash2 - d * 13); 422 Hash2 := d 423 end; 424 result := integer(Domain shl 30 + Hash1 xor Hash2r) 425 end 426 end; 427 428 function ProcessEnhancement(uix: integer; 429 const Jobs: TEnhancementJobs): integer; 423 end; 424 425 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs): integer; 430 426 { return values: 431 427 eJobDone - all applicable jobs done 432 428 eOK - enhancement not complete 433 429 eDied - job done and died (thurst) } 434 var 435 stage, NextJob, Tile: integer; 436 Done: Set of jNone .. jPoll; 437 begin 438 Done := []; 439 Tile := MyMap[MyUn[uix].Loc]; 440 if Tile and fRoad <> 0 then 441 include(Done, jRoad); 442 if Tile and fRR <> 0 then 443 include(Done, jRR); 444 if (Tile and fTerImp = tiIrrigation) or (Tile and fTerImp = tiFarm) then 445 include(Done, jIrr); 446 if Tile and fTerImp = tiFarm then 447 include(Done, jFarm); 448 if Tile and fTerImp = tiMine then 449 include(Done, jMine); 450 if Tile and fPoll = 0 then 451 include(Done, jPoll); 452 453 if MyUn[uix].Job = jNone then 454 result := eJobDone 455 else 456 result := eOK; 457 while (result <> eOK) and (result <> eDied) do 430 var 431 stage, NextJob, Tile: integer; 432 Done: set of jNone .. jPoll; 433 begin 434 Done := []; 435 Tile := MyMap[MyUn[uix].Loc]; 436 if Tile and fRoad <> 0 then 437 include(Done, jRoad); 438 if Tile and fRR <> 0 then 439 include(Done, jRR); 440 if (Tile and fTerImp = tiIrrigation) or (Tile and fTerImp = tiFarm) then 441 include(Done, jIrr); 442 if Tile and fTerImp = tiFarm then 443 include(Done, jFarm); 444 if Tile and fTerImp = tiMine then 445 include(Done, jMine); 446 if Tile and fPoll = 0 then 447 include(Done, jPoll); 448 449 if MyUn[uix].Job = jNone then 450 Result := eJobDone 451 else 452 Result := eOK; 453 while (Result <> eOK) and (Result <> eDied) do 454 begin 455 stage := -1; 456 repeat 457 if stage = -1 then 458 NextJob := jPoll 459 else 460 NextJob := Jobs[Tile and fTerrain, stage]; 461 if (NextJob = jNone) or not (NextJob in Done) then 462 Break; 463 Inc(stage); 464 until stage = 5; 465 if (stage = 5) or (NextJob = jNone) then 458 466 begin 459 stage := -1; 460 repeat 461 if stage = -1 then 462 NextJob := jPoll 463 else 464 NextJob := Jobs[Tile and fTerrain, stage]; 465 if (NextJob = jNone) or not(NextJob in Done) then 466 Break; 467 inc(stage); 468 until stage = 5; 469 if (stage = 5) or (NextJob = jNone) then 467 Result := eJobDone; 468 Break; 469 end; // tile enhancement complete 470 Result := Server(sStartJob + NextJob shl 4, me, uix, nil^); 471 include(Done, NextJob); 472 end; 473 end; 474 475 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 476 var 477 i, NewProject: integer; 478 begin 479 Result := False; 480 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) or 481 (MyCity[cix].Flags and chProduction <> 0) then 482 begin 483 i := 0; 484 repeat 485 while (ImpOrder[i] >= 0) and (MyCity[cix].Built[ImpOrder[i]] > 0) do 486 Inc(i); 487 if ImpOrder[i] < 0 then 488 Break; 489 assert(i < nImp); 490 NewProject := cpImp + ImpOrder[i]; 491 if Server(sSetCityProject, me, cix, NewProject) >= rExecuted then 470 492 begin 471 result := eJobDone; 493 Result := True; 494 CityOptimizer_CityChange(cix); 472 495 Break; 473 end; // tile enhancement complete 474 result := Server(sStartJob + NextJob shl 4, me, uix, nil^); 475 include(Done, NextJob) 496 end; 497 Inc(i); 498 until False; 499 end; 500 end; 501 502 procedure CalculateAdvValues; 503 var 504 i, j: integer; 505 known: array [0 .. nAdv - 1] of integer; 506 507 procedure MarkPreqs(i: integer); 508 begin 509 if known[i] = 0 then 510 begin 511 known[i] := 1; 512 if (i <> adScience) and (i <> adMassProduction) then 513 begin 514 if (AdvPreq[i, 0] >= 0) then 515 MarkPreqs(AdvPreq[i, 0]); 516 if (AdvPreq[i, 1] >= 0) then 517 MarkPreqs(AdvPreq[i, 1]); 518 end; 476 519 end; 477 520 end; 478 521 479 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 480 var 481 i, NewProject: integer; 482 begin 483 result := false; 484 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) or 485 (MyCity[cix].Flags and chProduction <> 0) then 522 begin 523 FillChar(AdvValue, SizeOf(AdvValue), 0); 524 for i := 0 to nAdv - 1 do 525 begin 526 FillChar(known, SizeOf(known), 0); 527 MarkPreqs(i); 528 for j := 0 to nAdv - 1 do 529 if known[j] > 0 then 530 Inc(AdvValue[i]); 531 if i in FutureTech then 532 Inc(AdvValue[i], 3000) 533 else if known[adMassProduction] > 0 then 534 Inc(AdvValue[i], 2000) 535 else if known[adScience] > 0 then 536 Inc(AdvValue[i], 1000); 537 end; 538 end; 539 540 procedure DebugMessage(Level: integer; Text: string); 541 begin 542 Server(sMessage, me, Level, PChar(Text)^); 543 end; 544 545 function MarkCitiesAround(Loc, cixExcept: integer): boolean; 546 // return whether a city was marked 547 var 548 cix: integer; 549 begin 550 Result := False; 551 for cix := 0 to MyRO.nCity - 1 do 552 if (cix <> cixExcept) and (MyCity[cix].Loc >= 0) and 553 (MyCity[cix].Flags and chCaptured = 0) and 554 (Distance(MyCity[cix].Loc, Loc) <= 5) then 486 555 begin 487 i := 0; 488 repeat 489 while (ImpOrder[i] >= 0) and (MyCity[cix].Built[ImpOrder[i]] > 0) do 490 inc(i); 491 if ImpOrder[i] < 0 then 492 Break; 493 assert(i < nImp); 494 NewProject := cpImp + ImpOrder[i]; 495 if Server(sSetCityProject, me, cix, NewProject) >= rExecuted then 556 CityNeedsOptimize[cix] := True; 557 Result := True; 558 end; 559 end; 560 561 procedure OptimizeCities(CheckOnly: boolean); 562 var 563 cix, fix, dx, dy, Loc1, OptiType: integer; 564 Done: boolean; 565 Advice: TCityTileAdviceData; 566 begin 567 repeat 568 Done := True; 569 for cix := 0 to MyRO.nCity - 1 do 570 if CityNeedsOptimize[cix] then 571 begin 572 OptiType := (MyCity[cix].Status shr 4) and $0F; 573 if OptiType <> 0 then 496 574 begin 497 result := true; 498 CityOptimizer_CityChange(cix); 499 Break; 575 Advice.ResourceWeights := OfferedResourceWeights[OptiType]; 576 Server(sGetCityTileAdvice, me, cix, Advice); 577 if Advice.Tiles <> MyCity[cix].Tiles then 578 if CheckOnly then 579 begin 580 // TODO: What is this assert for? 581 // Need to optimize city tiles but CheckOnly true? 582 //assert(false) 583 end 584 else 585 begin 586 for fix := 1 to 26 do 587 if MyCity[cix].Tiles and not Advice.Tiles and 588 (1 shl fix) <> 0 then 589 begin // tile no longer used by this city -- check using it by another 590 dy := fix shr 2 - 3; 591 dx := fix and 3 shl 1 - 3 + (dy + 3) and 1; 592 Loc1 := dLoc(MyCity[cix].Loc, dx, dy); 593 if MarkCitiesAround(Loc1, cix) then 594 Done := False; 595 end; 596 Server(sSetCityTiles, me, cix, Advice.Tiles); 597 end; 500 598 end; 501 inc(i); 502 until false end end; 503 504 procedure CalculateAdvValues; 505 var 506 i, j: integer; 507 known: array [0 .. nAdv - 1] of integer; 508 509 procedure MarkPreqs(i: integer); 510 begin 511 if known[i] = 0 then 512 begin 513 known[i] := 1; 514 if (i <> adScience) and (i <> adMassProduction) then 515 begin 516 if (AdvPreq[i, 0] >= 0) then 517 MarkPreqs(AdvPreq[i, 0]); 518 if (AdvPreq[i, 1] >= 0) then 519 MarkPreqs(AdvPreq[i, 1]); 520 end 521 end 522 end; 523 599 CityNeedsOptimize[cix] := False; 600 end; 601 until Done; 602 end; 603 604 procedure CityOptimizer_BeginOfTurn; 605 var 606 cix: integer; 607 begin 608 FillChar(CityNeedsOptimize, MyRO.nCity - 1, 0); // false 609 if MyRO.Government <> gAnarchy then 610 begin 611 for cix := 0 to MyRO.nCity - 1 do 612 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Flags and chCaptured = 0) 613 then 614 CityNeedsOptimize[cix] := True; 615 OptimizeCities(False); // optimize all cities 616 end; 617 end; 618 619 procedure CityOptimizer_CityChange(cix: integer); 620 begin 621 if (MyRO.Government <> gAnarchy) and (MyCity[cix].Flags and 622 chCaptured = 0) then 623 begin 624 CityNeedsOptimize[cix] := True; 625 OptimizeCities(False); 626 end; 627 end; 628 629 procedure CityOptimizer_TileBecomesAvailable(Loc: integer); 630 begin 631 if (MyRO.Government <> gAnarchy) and MarkCitiesAround(Loc, -1) then 632 OptimizeCities(False); 633 end; 634 635 procedure CityOptimizer_ReleaseCityTiles(cix, ReleasedTiles: integer); 636 var 637 fix, dx, dy, Loc1: integer; 638 Done: boolean; 639 begin 640 if (MyRO.Government <> gAnarchy) and (ReleasedTiles <> 0) then 641 begin 642 Done := True; 643 for fix := 1 to 26 do 644 if ReleasedTiles and (1 shl fix) <> 0 then 524 645 begin 525 FillChar(AdvValue, SizeOf(AdvValue), 0); 526 for i := 0 to nAdv - 1 do 527 begin 528 FillChar(known, SizeOf(known), 0); 529 MarkPreqs(i); 530 for j := 0 to nAdv - 1 do 531 if known[j] > 0 then 532 inc(AdvValue[i]); 533 if i in FutureTech then 534 inc(AdvValue[i], 3000) 535 else if known[adMassProduction] > 0 then 536 inc(AdvValue[i], 2000) 537 else if known[adScience] > 0 then 538 inc(AdvValue[i], 1000) 539 end; 646 dy := fix shr 2 - 3; 647 dx := fix and 3 shl 1 - 3 + (dy + 3) and 1; 648 Loc1 := dLoc(MyCity[cix].Loc, dx, dy); 649 if MarkCitiesAround(Loc1, cix) then 650 Done := False; 540 651 end; 541 542 procedure DebugMessage(Level: integer; Text: string); 543 begin 544 Server(sMessage, me, Level, pchar(Text)^) 545 end; 546 547 function MarkCitiesAround(Loc, cixExcept: integer): boolean; 548 // return whether a city was marked 549 var 550 cix: integer; 551 begin 552 result := false; 553 for cix := 0 to MyRO.nCity - 1 do 554 if (cix <> cixExcept) and (MyCity[cix].Loc >= 0) and 555 (MyCity[cix].Flags and chCaptured = 0) and 556 (Distance(MyCity[cix].Loc, Loc) <= 5) then 557 begin 558 CityNeedsOptimize[cix] := true; 559 result := true; 560 end 561 end; 562 563 procedure OptimizeCities(CheckOnly: boolean); 564 var 565 cix, fix, dx, dy, Loc1, OptiType: integer; 566 Done: boolean; 567 Advice: TCityTileAdviceData; 568 begin 569 repeat 570 Done := true; 571 for cix := 0 to MyRO.nCity - 1 do 572 if CityNeedsOptimize[cix] then begin 573 OptiType := (MyCity[cix].Status shr 4) and $0F; 574 if OptiType <> 0 then begin 575 Advice.ResourceWeights := OfferedResourceWeights[OptiType]; 576 Server(sGetCityTileAdvice, me, cix, Advice); 577 if Advice.Tiles <> MyCity[cix].Tiles then 578 if CheckOnly then begin 579 // TODO: What is this assert for? 580 // Need to optimize city tiles but CheckOnly true? 581 //assert(false) 582 end else begin 583 for fix := 1 to 26 do 584 if MyCity[cix].Tiles and not Advice.Tiles and 585 (1 shl fix) <> 0 then 586 begin // tile no longer used by this city -- check using it by another 587 dy := fix shr 2 - 3; 588 dx := fix and 3 shl 1 - 3 + (dy + 3) and 1; 589 Loc1 := dLoc(MyCity[cix].Loc, dx, dy); 590 if MarkCitiesAround(Loc1, cix) then 591 Done := false; 592 end; 593 Server(sSetCityTiles, me, cix, Advice.Tiles); 594 end; 595 end; 596 CityNeedsOptimize[cix] := false; 597 end; 598 until Done; 599 end; 600 601 procedure CityOptimizer_BeginOfTurn; 602 var 603 cix: integer; 604 begin 605 FillChar(CityNeedsOptimize, MyRO.nCity - 1, 0); // false 606 if MyRO.Government <> gAnarchy then 607 begin 608 for cix := 0 to MyRO.nCity - 1 do 609 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Flags and chCaptured = 0) 610 then 611 CityNeedsOptimize[cix] := true; 612 OptimizeCities(false); // optimize all cities 613 end 614 end; 615 616 procedure CityOptimizer_CityChange(cix: integer); 617 begin 618 if (MyRO.Government <> gAnarchy) and 619 (MyCity[cix].Flags and chCaptured = 0) then 620 begin 621 CityNeedsOptimize[cix] := true; 622 OptimizeCities(false); 623 end 624 end; 625 626 procedure CityOptimizer_TileBecomesAvailable(Loc: integer); 627 begin 628 if (MyRO.Government <> gAnarchy) and MarkCitiesAround(Loc, -1) then 629 OptimizeCities(false); 630 end; 631 632 procedure CityOptimizer_ReleaseCityTiles(cix, ReleasedTiles: integer); 633 var 634 fix, dx, dy, Loc1: integer; 635 Done: boolean; 636 begin 637 if (MyRO.Government <> gAnarchy) and (ReleasedTiles <> 0) then 638 begin 639 Done := true; 640 for fix := 1 to 26 do 641 if ReleasedTiles and (1 shl fix) <> 0 then 642 begin 643 dy := fix shr 2 - 3; 644 dx := fix and 3 shl 1 - 3 + (dy + 3) and 1; 645 Loc1 := dLoc(MyCity[cix].Loc, dx, dy); 646 if MarkCitiesAround(Loc1, cix) then 647 Done := false; 648 end; 649 if not Done then 650 OptimizeCities(false); 651 end 652 end; 653 654 procedure CityOptimizer_BeforeRemoveUnit(uix: integer); 655 var 656 uix1: integer; 657 begin 658 if MyRO.Government <> gAnarchy then 659 begin 660 if MyUn[uix].Home >= 0 then 661 CityNeedsOptimize[MyUn[uix].Home] := true; 662 663 // transported units are also removed 664 for uix1 := 0 to MyRO.nUn - 1 do 665 if (MyUn[uix1].Loc >= 0) and (MyUn[uix1].Master = uix) and 666 (MyUn[uix1].Home >= 0) then 667 CityNeedsOptimize[MyUn[uix1].Home] := true; 668 end 669 end; 670 671 procedure CityOptimizer_AfterRemoveUnit; 672 begin 673 if MyRO.Government <> gAnarchy then 674 OptimizeCities(false); 675 end; 676 677 procedure CityOptimizer_EndOfTurn; 678 // all cities should already be optimized here -- only check this 679 var 680 cix: integer; 681 begin 652 if not Done then 653 OptimizeCities(False); 654 end; 655 end; 656 657 procedure CityOptimizer_BeforeRemoveUnit(uix: integer); 658 var 659 uix1: integer; 660 begin 661 if MyRO.Government <> gAnarchy then 662 begin 663 if MyUn[uix].Home >= 0 then 664 CityNeedsOptimize[MyUn[uix].Home] := True; 665 666 // transported units are also removed 667 for uix1 := 0 to MyRO.nUn - 1 do 668 if (MyUn[uix1].Loc >= 0) and (MyUn[uix1].Master = uix) and 669 (MyUn[uix1].Home >= 0) then 670 CityNeedsOptimize[MyUn[uix1].Home] := True; 671 end; 672 end; 673 674 procedure CityOptimizer_AfterRemoveUnit; 675 begin 676 if MyRO.Government <> gAnarchy then 677 OptimizeCities(False); 678 end; 679 680 procedure CityOptimizer_EndOfTurn; 681 // all cities should already be optimized here -- only check this 682 var 683 cix: integer; 684 begin 682 685 {$IFOPT O-} 683 684 685 686 687 688 689 CityNeedsOptimize[cix] := true;690 OptimizeCities(true); // check all cities691 686 if MyRO.Government <> gAnarchy then 687 begin 688 FillChar(CityNeedsOptimize, MyRO.nCity - 1, 0); // false 689 for cix := 0 to MyRO.nCity - 1 do 690 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Flags and chCaptured = 0) 691 then 692 CityNeedsOptimize[cix] := True; 693 OptimizeCities(True); // check all cities 694 end; 692 695 {$ENDIF} 693 696 end; 694 697 695 698 initialization 696 699 697 Assert(nImp < 128);698 CalculateAdvValues;700 Assert(nImp < 128); 701 CalculateAdvValues; 699 702 700 703 end. -
branches/highdpi/LocalPlayer/Draft.pas
r210 r303 92 92 Template := TDpiBitmap.Create; 93 93 Template.PixelFormat := pf24bit; 94 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'MiliRes.png', gfNoGamma); 94 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'MiliRes.png', 95 [gfNoGamma]); 95 96 end; 96 97 -
branches/highdpi/LocalPlayer/Enhance.pas
r244 r303 366 366 Shift: TShiftState); 367 367 begin 368 if Key = VK_ESCAPE then 369 Close 370 else if Key = VK_F1 then 368 if Key = VK_F1 then 371 369 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 372 370 HelpDlg.TextIndex('MACRO')) -
branches/highdpi/LocalPlayer/Help.pas
r265 r303 127 127 128 128 uses 129 Directories, ClientTools, Term, Tribes, Inp, Messg, UPixelPointer, Global; 129 Directories, ClientTools, Term, Tribes, Inp, Messg, UPixelPointer, Global, 130 UKeyBindings; 130 131 131 132 {$R *.lfm} … … 207 208 destructor THyperText.Destroy; 208 209 begin 209 inherited Destroy;210 inherited; 210 211 end; 211 212 … … 1242 1243 until FindNext(sr) <> 0; 1243 1244 FindClose(sr); 1244 Plus.Free;1245 FreeAndNil(Plus); 1245 1246 1246 1247 List.Sort; … … 1259 1260 MainText.AddLine(s); 1260 1261 end; 1261 List.Free;1262 FreeAndNil(List); 1262 1263 end; 1263 1264 … … 1277 1278 MainText.AddLine(s); 1278 1279 end; 1279 List.Free;1280 FreeAndNil(List); 1280 1281 end; 1281 1282 … … 1439 1440 AppendList(List); 1440 1441 end; 1441 List.Free;1442 FreeAndNil(List); 1442 1443 end 1443 1444 else // single advance … … 1538 1539 List.Sort; 1539 1540 AppendList(List); 1540 List.Free;1541 FreeAndNil(List); 1541 1542 end 1542 1543 else if no = 201 then … … 1827 1828 AppendList(List); 1828 1829 end; 1829 List.Free;1830 FreeAndNil(List); 1830 1831 end 1831 1832 else … … 1988 1989 OffscreenPaint; 1989 1990 Invalidate; 1990 HistItem.Free;1991 FreeAndNil(HistItem); 1991 1992 end; 1992 1993 end; … … 2016 2017 Shift: TShiftState); 2017 2018 begin 2018 if Key = VK_F1then // my key2019 if KeyToShortCut(Key, Shift) = BHelp.ShortCut then // my key 2019 2020 else 2020 inherited 2021 inherited; 2021 2022 end; 2022 2023 -
branches/highdpi/LocalPlayer/IsoEngine.pas
r265 r303 133 133 OnInitEnemyModel := InitEnemyModelHandler; 134 134 if NoMap <> nil then 135 NoMap.Free;135 FreeAndNil(NoMap); 136 136 NoMap := TIsoMap.Create; 137 137 end; … … 168 168 { prepare dithered ground tiles } 169 169 if LandPatch <> nil then 170 LandPatch.Free;170 FreeAndNil(LandPatch); 171 171 LandPatch := TDpiBitmap.Create; 172 172 LandPatch.PixelFormat := pf24bit; … … 175 175 LandPatch.Canvas.FillRect(0, 0, LandPatch.Width, LandPatch.Height); 176 176 if OceanPatch <> nil then 177 OceanPatch.Free;177 FreeAndNil(OceanPatch); 178 178 OceanPatch := TDpiBitmap.Create; 179 179 OceanPatch.PixelFormat := pf24bit; … … 363 363 DitherMask.Canvas, 0, 0, SRCAND); 364 364 365 LandMore.Free;366 OceanMore.Free;367 DitherMask.Free;365 FreeAndNil(LandMore); 366 FreeAndNil(OceanMore); 367 FreeAndNil(DitherMask); 368 368 369 369 // reduce size of terrain icons … … 417 417 end; 418 418 Mask24.EndUpdate; 419 Mask24.Free;419 FreeAndNil(Mask24); 420 420 421 421 if Borders <> nil then 422 Borders.Free;422 FreeAndNil(Borders); 423 423 Borders := TDpiBitmap.Create; 424 424 Borders.PixelFormat := pf24bit; … … 702 702 end; 703 703 Textout(xShield + 2, yShield - 1, LabelTextColor, s); 704 end 704 end; 705 705 end; { PaintCity } 706 706 … … 1078 1078 if not(FoW and (Tile and fObserved = 0)) then 1079 1079 PaintBorder; 1080 1080 1081 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Loc = FAdviceLoc) then 1081 1082 TSprite(x, y, spPlain); … … 1287 1288 i: integer; 1288 1289 begin 1289 FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3));1290 1290 FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3)); 1291 1291 for i := 0 to nx div 2 do -
branches/highdpi/LocalPlayer/MessgEx.pas
r253 r303 218 218 end 219 219 else 220 result := inherited ShowModal;220 result := inherited; 221 221 end; 222 222 -
branches/highdpi/LocalPlayer/NatStat.pas
r244 r303 93 93 Template := TDpiBitmap.Create; 94 94 Template.PixelFormat := pf24bit; 95 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Nation.png', gfNoGamma); 95 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Nation.png', 96 [gfNoGamma]); 96 97 end; 97 98 98 99 procedure TNatStatDlg.FormDestroy(Sender: TObject); 99 100 begin 100 ReportText.Free;101 FreeAndNil(ReportText); 101 102 FreeMem(SelfReport); 102 Template.Free;103 Back.Free;103 FreeAndNil(Template); 104 FreeAndNil(Back); 104 105 end; 105 106 -
branches/highdpi/LocalPlayer/Select.pas
r273 r303 1605 1605 CaptionRight := CloseBtn.Left; 1606 1606 { TODO: 1607 SetWindowPos(sb.ScrollBar.Handle, 0, SideFrame + InnerWidth - GetSystemMetrics(SM_CXVSCROLL),1607 SetWindowPos(sb.ScrollBar.Handle, 0, SideFrame + InnerWidth - DpiGetSystemMetrics(SM_CXVSCROLL), 1608 1608 TitleHeight, DpiGetSystemMetrics(SM_CXVSCROLL), LineDistance * DispLines + 48, 1609 1609 SWP_NOZORDER or SWP_NOREDRAW); -
branches/highdpi/LocalPlayer/TechTree.pas
r246 r303 23 23 Shift: TShiftState; X, Y: Integer); 24 24 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 25 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);26 25 procedure CloseBtnClick(Sender: TObject); 27 26 private … … 133 132 NewHeight: Integer; 134 133 const 135 TransparentColor = $7F007F;134 TransparentColor: Cardinal = $7F007F; 136 135 begin 137 136 if Image = nil then begin 138 137 Image := TDpiBitmap.Create; 139 138 Image.PixelFormat := pf24bit; 140 LoadGraphicFile(Image, HomeDir + 'Help' + DirectorySeparator + 'AdvTree.png', gfNoGamma); 139 LoadGraphicFile(Image, HomeDir + 'Help' + DirectorySeparator + 'AdvTree.png', 140 [gfNoGamma]); 141 141 142 142 with Image.Canvas do begin … … 228 228 end; 229 229 230 procedure TTechTreeDlg.FormKeyDown(Sender: TObject; var Key: Word;231 Shift: TShiftState);232 begin233 if Key = VK_ESCAPE then234 Close;235 end;236 237 230 procedure TTechTreeDlg.CloseBtnClick(Sender: TObject); 238 231 begin -
branches/highdpi/LocalPlayer/Term.pas
r265 r303 235 235 Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase, 236 236 HaveStrategyAdvice, FirstMovieTurn: boolean; 237 PrevWindowState: TWindowState; 238 CurrentWindowState: TWindowState; 237 239 function ChooseUnusedTribe: integer; 238 240 procedure GetTribeList; … … 283 285 procedure OnEOT(var Msg: TMessage); message WM_EOT; 284 286 procedure SoundPreload(Check: integer); 287 procedure UpdateKeyShortcuts; 288 procedure SetFullScreen(Active: Boolean); 285 289 public 286 290 UsedOffscreenWidth, UsedOffscreenHeight: integer; … … 307 311 FileName: ShortString; 308 312 end; 309 310 313 TCityNameInfo = record 311 314 ID: integer; 312 NewName: ShortString end; 313 TModelNameInfo = record mix: integer; 314 NewName: ShortString end; 315 TPriceSet = Set of $00 .. $FF; 315 NewName: ShortString; 316 end; 317 TModelNameInfo = record 318 mix: integer; 319 NewName: ShortString; 320 end; 321 TPriceSet = Set of $00 .. $FF; 316 322 317 323 const … … 481 487 Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help, 482 488 UnitStat, Log, Diagram, NatStat, Wonders, Enhance, Nego, UPixelPointer, Sound, 483 Battle, Rates, TechTree, Registry, Global ;489 Battle, Rates, TechTree, Registry, Global, UKeyBindings; 484 490 485 491 {$R *.lfm} … … 531 537 SmallScreen, GameOK, MapValid, skipped, idle: boolean; 532 538 533 SaveOption: array [0 ..nSaveOption - 1] of integer;534 MiniColors: array [0 .. $1f, 0 ..1] of TColor;539 SaveOption: array [0..nSaveOption - 1] of integer; 540 MiniColors: array [0..11, 0..1] of TColor; 535 541 MainMap: TIsoMap; 536 542 CurrentMoveInfo: record AfterMovePaintRadius, AfterAttackExpeller: integer; … … 551 557 procedure InitSmallImp; 552 558 const 553 cut = 4;559 Cut = 4; 554 560 Sharpen = 80; 555 561 type … … 742 748 ChooseModelPicture(Owner, mix, ModelCode(MyRO.EnemyModel[emix]), 743 749 ModelHash(MyRO.EnemyModel[emix]), MyRO.Turn, false, true); 744 result := true 750 result := true; 745 751 end; 746 752 … … 786 792 function CreateTribe(p: integer; FileName: string; Original: boolean): boolean; 787 793 begin 788 if not FileExists(LocalizedFilePath('Tribes' + DirectorySeparator + FileName + 789 '.tribe.txt')) then 790 begin 791 result := false; 792 exit 794 FileName := LocalizedFilePath('Tribes' + DirectorySeparator + FileName + 795 CevoTribeExt); 796 if not FileExists(FileName) then 797 begin 798 Result := False; 799 Exit; 793 800 end; 794 801 … … 879 886 MyModel[mix].Status := MyModel[mix].Status or msObsolete; 880 887 end; 881 inc(MyData.ToldModels) 888 inc(MyData.ToldModels); 882 889 end; 883 890 end; … … 1123 1130 if UnitStatDlg.Visible then 1124 1131 UnitStatDlg.Close; 1125 end 1126 end 1132 end; 1133 end; 1127 1134 end; 1128 1135 … … 1151 1158 if UnitStatDlg.Visible then 1152 1159 UnitStatDlg.Close; 1153 end 1154 end 1160 end; 1161 end; 1155 1162 end; 1156 1163 … … 1175 1182 UnFocus := -1; 1176 1183 PaintLoc(Loc0); 1177 end 1184 end; 1178 1185 end; 1179 1186 UnFocus := uix; … … 1220 1227 MovieSpeed3Btn.Visible := false; 1221 1228 MovieSpeed4Btn.Visible := false; 1222 end 1229 end; 1223 1230 end; 1224 1231 … … 1248 1255 if AILogo[p] <> nil then 1249 1256 begin 1250 AILogo[p].free; 1251 AILogo[p] := nil 1252 end 1257 FreeAndNil(AILogo[p]); 1258 end; 1253 1259 end 1254 1260 else … … 1256 1262 if AILogo[p] = nil then 1257 1263 AILogo[p] := TDpiBitmap.Create; 1258 if not LoadGraphicFile(AILogo[p], HomeDir + Name + '.png', gfNoError) then 1259 begin 1260 AILogo[p].free; 1261 AILogo[p] := nil 1262 end 1263 end 1264 if not LoadGraphicFile(AILogo[p], HomeDir + Name + '.png', [gfNoError]) then 1265 begin 1266 FreeAndNil(AILogo[p]); 1267 end; 1268 end; 1264 1269 end; 1265 1270 … … 1296 1301 MapValid := false; 1297 1302 PaintAllMaps; 1298 end 1299 end 1303 end; 1304 end; 1300 1305 end; 1301 1306 … … 1415 1420 begin 1416 1421 UnusedTribeFiles.Clear; 1417 ok := FindFirst(LocalizedFilePath('Tribes') + DirectorySeparator + '* .tribe.txt',1422 ok := FindFirst(LocalizedFilePath('Tribes') + DirectorySeparator + '*' + CevoTribeExt, 1418 1423 faArchive + faReadOnly, SearchRec) = 0; 1419 1424 if not ok then 1420 1425 begin 1421 1426 FindClose(SearchRec); 1422 ok := FindFirst(LocalizedFilePath('Tribes' + DirectorySeparator + '* .tribe.txt'),1427 ok := FindFirst(LocalizedFilePath('Tribes' + DirectorySeparator + '*' + CevoTribeExt), 1423 1428 faArchive + faReadOnly, SearchRec) = 0; 1424 1429 end; 1425 1430 if ok then 1426 1431 repeat 1427 SearchRec.Name := Copy(SearchRec.Name, 1, Length(SearchRec.Name) - 10);1432 SearchRec.Name := Copy(SearchRec.Name, 1, Length(SearchRec.Name) - Length(CevoTribeExt)); 1428 1433 if GetTribeInfo(SearchRec.Name, Name, Color) then 1429 1434 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); … … 1434 1439 function TMainScreen.ChooseUnusedTribe: integer; 1435 1440 var 1436 i, j, ColorDistance, BestColorDistance, TestColorDistance, 1437 CountBest: integer; 1441 i: Integer; 1442 j: Integer; 1443 ColorDistance: Integer; 1444 BestColorDistance: Integer; 1445 TestColorDistance: Integer; 1446 CountBest: Integer; 1438 1447 begin 1439 1448 assert(UnusedTribeFiles.Count > 0); … … 1465 1474 if DelphiRandom(CountBest) = 0 then 1466 1475 result := j 1467 end 1476 end; 1468 1477 end; 1469 1478 end; … … 1523 1532 IconKind := mikShip; 1524 1533 IconIndex := Ship2Owner; 1525 end 1534 end; 1526 1535 end; 1527 1536 … … 1536 1545 MostCost := TestCost; 1537 1546 IconIndex := imShipComp + i 1538 end 1547 end; 1539 1548 end; 1540 1549 end; … … 1619 1628 sb := TPVScrollbar.Create(Self); 1620 1629 sb.OnUpdate := ScrollBarUpdate; 1621 end; { InitModule }1630 end; 1622 1631 1623 1632 procedure TMainScreen.InitTurn(NewPlayer: integer); … … 2237 2246 Flags and CityRepMask); 2238 2247 UpdatePanel := true; 2239 end 2248 end; 2240 2249 end 2241 2250 else { if mRepList.Checked then } … … 2243 2252 if Flags and CityRepMask <> 0 then 2244 2253 ShowCityList := true 2245 end 2246 end 2254 end; 2255 end; 2247 2256 end; { city loop } 2248 2257 end; // ClientMode=cTurn … … 2263 2272 Play('REVOLUTION'); 2264 2273 Server(sRevolution, me, 0, nil^); 2265 end 2274 end; 2266 2275 end; 2267 2276 end; // ClientMode=cTurn … … 2382 2391 else 2383 2392 Status := Status and not usWaiting; 2384 end 2393 end; 2385 2394 end; 2386 2395 end; // ClientMode=cTurn … … 2480 2489 opAllModel: 2481 2490 s := s + 'All models'; 2482 end 2491 end; 2483 2492 end; 2484 2493 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); … … 2488 2497 s := s + '--- ACCEPTED! ---'; 2489 2498 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2490 end 2499 end; 2491 2500 end; 2492 2501 … … 2502 2511 cReleaseModule: 2503 2512 begin 2504 SmallImp.free;2505 UnusedTribeFiles.free;2506 TribeNames.free;2507 MainMap.free;2513 FreeAndNil(SmallImp); 2514 FreeAndNil(UnusedTribeFiles); 2515 FreeAndNil(TribeNames); 2516 FreeAndNil(MainMap); 2508 2517 IsoEngine.Done; 2509 2518 // AdvisorDlg.DeInit; … … 2703 2712 for p1 := 0 to nPl - 1 do 2704 2713 if Tribe[p1] <> nil then 2705 Tribe[p1].free;2714 FreeAndNil(Tribe[p1]); 2706 2715 Tribes.Done; 2707 2716 RepaintOnResize := false; … … 2844 2853 // this break will ensure speed of fast forward does not depend on cpu speed 2845 2854 DpiApplication.ProcessMessages; 2846 end 2855 end; 2847 2856 end; 2848 2857 … … 2923 2932 DipCall(scReject); 2924 2933 EndNego 2925 end 2926 end 2934 end; 2935 end; 2927 2936 end; 2928 2937 end; … … 3410 3419 i, j: integer; 3411 3420 begin 3421 KeyBindings.LoadFromRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings'); 3422 UpdateKeyShortcuts; 3423 3412 3424 MainFormKeyDown := FormKeyDown; 3413 3425 BaseWin.CreateOffscreen(Offscreen); … … 3512 3524 I: Integer; 3513 3525 begin 3526 KeyBindings.SaveToRegistry(HKEY_CURRENT_USER, AppRegistryKey + '\KeyBindings'); 3514 3527 MainFormKeyDown := nil; 3515 3528 FreeAndNil(sb); … … 3615 3628 RectInvalidate(0, TopBarHeight, ClientWidth, TopBarHeight + MapHeight); 3616 3629 MapValid := false; 3617 PaintAll 3618 end 3630 PaintAll; 3631 end; 3619 3632 end; 3620 3633 … … 3623 3636 CanClose := Closable; 3624 3637 if not Closable and idle and (me = 0) and (ClientMode < scContact) then 3625 MenuClick(mResign) 3638 MenuClick(mResign); 3626 3639 end; 3627 3640 … … 4061 4074 var 4062 4075 uix, cix, x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer; 4063 PrevMiniPixel, MiniPixel: TPixelPointer; 4076 PrevMiniPixel: TPixelPointer; 4077 MiniPixel: TPixelPointer; 4078 TerrainTile: Cardinal; 4064 4079 begin 4065 4080 cmPolOcean := GrExt[HGrSystem].Data.Canvas.Pixels[101, 67]; … … 4085 4100 ScaleToNative(G.lx) * 5) mod (ScaleToNative(G.lx) * 2); 4086 4101 MiniPixel.SetXY(xm, y); 4087 cm := MiniColors[MyMap[Loc] and fTerrain, i]; 4102 TerrainTile := MyMap[Loc] and fTerrain; 4103 if TerrainTile > 11 then TerrainTile := 0; 4104 cm := MiniColors[TerrainTile, i]; 4088 4105 if ClientMode = cEditMap then 4089 4106 begin … … 6422 6439 MapValid := false; 6423 6440 PaintAllMaps; 6424 end 6441 end; 6442 end; 6443 6444 procedure TMainScreen.UpdateKeyShortcuts; 6445 begin 6446 mHelp.ShortCut := BHelp.ShortCut; 6447 mUnitStat.ShortCut := BUnitStat.ShortCut; 6448 mCityStat.ShortCut := BCityStat.ShortCut; 6449 mScienceStat.ShortCut := BScienceStat.ShortCut; 6450 mEUnitStat.ShortCut := BEUnitStat.ShortCut;; 6451 mDiagram.ShortCut := BDiagram.ShortCut; 6452 mWonders.ShortCut := BWonders.ShortCut; 6453 mShips.ShortCut := BShips.ShortCut; 6454 mNations.ShortCut := BNations.ShortCut; 6455 mEmpire.ShortCut := BEmpire.ShortCut; 6456 mResign.ShortCut := BResign.ShortCut; 6457 mRandomMap.ShortCut := BRandomMap.ShortCut; 6458 mDisband.ShortCut := BDisbandUnit.ShortCut; 6459 mFort.ShortCut := BFortify.ShortCut; 6460 mCentre.ShortCut := BCenterUnit.ShortCut; 6461 mStay.ShortCut := BStay.ShortCut; 6462 mNoOrders.ShortCut := BNoOrders.ShortCut; 6463 mCancel.ShortCut := BCancel.ShortCut; 6464 mPillage.ShortCut := BPillage.ShortCut; 6465 mTechTree.ShortCut := BTechTree.ShortCut; 6466 mWait.ShortCut := BWait.ShortCut; 6467 mJump.ShortCut := BJump.ShortCut;; 6468 mDebugMap.ShortCut := BDebugMap.ShortCut; 6469 mLocCodes.ShortCut := BLocCodes.ShortCut; 6470 mNames.ShortCut := BNames.ShortCut; 6471 mRun.ShortCut := BRun.ShortCut; 6472 mAirBase.ShortCut := BAirBase.ShortCut; 6473 mCity.ShortCut := BBuildCity.ShortCut; 6474 mEnhance.ShortCut := BEnhance.ShortCut; 6475 mGoOn.ShortCut := BGoOn.ShortCut; 6476 mHome.ShortCut := BHome.ShortCut; 6477 mFarm.ShortCut := BFarmClearIrrigation.ShortCut; 6478 mClear.ShortCut := BFarmClearIrrigation.ShortCut; 6479 mIrrigation.ShortCut := BFarmClearIrrigation.ShortCut; 6480 mLoad.ShortCut := BLoad.ShortCut; 6481 mAfforest.ShortCut := BAfforestMine.ShortCut; 6482 mMine.ShortCut := BAfforestMine.ShortCut; 6483 mCanal.ShortCut := BCanal.ShortCut; 6484 MTrans.ShortCut := BTrans.ShortCut; 6485 mPollution.ShortCut := BPollution.ShortCut; 6486 mRR.ShortCut := BRailRoad.ShortCut; 6487 mRoad.ShortCut := BRailRoad.ShortCut; 6488 mUnload.ShortCut := BUnload.ShortCut; 6489 mRecover.ShortCut := BRecover.ShortCut; 6490 mUtilize.ShortCut := BUtilize.ShortCut; 6491 end; 6492 6493 procedure TMainScreen.SetFullScreen(Active: Boolean); 6494 begin 6495 if Active and (CurrentWindowState <> wsFullScreen) then begin 6496 PrevWindowState := WindowState; 6497 CurrentWindowState := wsFullScreen; 6498 WindowState := CurrentWindowState; 6499 {$IFDEF WINDOWS} 6500 BorderStyle := bsNone; 6501 {$ENDIF} 6502 BorderIcons := []; 6503 end else 6504 if not Active and (CurrentWindowState = wsFullScreen) then begin 6505 if PrevWindowState = wsMaximized then begin 6506 CurrentWindowState := wsMaximized; 6507 WindowState := CurrentWindowState; 6508 end else begin 6509 CurrentWindowState := wsNormal; 6510 WindowState := CurrentWindowState; 6511 WindowState := wsFullScreen; 6512 WindowState := CurrentWindowState; 6513 end; 6514 {$IFDEF WINDOWS} 6515 BorderStyle := bsSizeable; 6516 {$ENDIF} 6517 BorderIcons := [biSystemMenu, biMinimize, biMaximize]; 6518 end; 6425 6519 end; 6426 6520 … … 6435 6529 end; 6436 6530 6531 procedure SetViewpointMe(p: Integer); 6532 begin 6533 if p = me then SetViewpoint(p) 6534 else SetViewpoint(p); 6535 end; 6536 6537 procedure DoMoveUnit(X, Y: Integer); 6538 begin 6539 DestinationMarkON := False; 6540 PaintDestination; 6541 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 6542 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting; 6543 MoveUnit(X, Y, muAutoNext); 6544 end; 6545 6437 6546 var 6438 dx, dy: integer; 6439 time0, time1: TDateTime; 6440 begin 6441 if GameMode = cMovie then 6442 begin 6443 case Key of 6444 VK_F4: 6445 MenuClick_Check(StatPopup, mScienceStat); 6446 VK_F6: 6447 MenuClick_Check(StatPopup, mDiagram); 6448 VK_F7: 6449 MenuClick_Check(StatPopup, mWonders); 6450 VK_F8: 6451 MenuClick_Check(StatPopup, mShips); 6452 end; 6453 exit; 6454 end; 6455 6456 if not idle then 6457 exit; 6458 6459 if ClientMode = cEditMap then 6460 begin 6461 if Shift = [ssCtrl] then 6547 Time0, Time1: TDateTime; 6548 ShortCut: TShortCut; 6549 begin 6550 ShortCut := KeyToShortCut(Key, Shift); 6551 6552 if GameMode = cMovie then begin 6553 if BScienceStat.Test(ShortCut) then MenuClick_Check(StatPopup, mScienceStat) 6554 else if BDiagram.Test(ShortCut) then MenuClick_Check(StatPopup, mDiagram) 6555 else if BWonders.Test(ShortCut) then MenuClick_Check(StatPopup, mWonders) 6556 else if BShips.Test(ShortCut) then MenuClick_Check(StatPopup, mShips); 6557 Exit; 6558 end; 6559 6560 if not Idle then Exit; 6561 6562 if ClientMode = cEditMap then begin 6563 if BResign.Test(ShortCut) then MenuClick(mResign) 6564 else if BRandomMap.Test(ShortCut) then MenuClick(mRandomMap) 6565 else if BHelp.Test(ShortCut) then MenuClick(mHelp); 6566 (*if Shift = [ssCtrl] then 6462 6567 case char(Key) of 6463 (*'A':6568 'A': 6464 6569 begin // auto symmetry 6465 6570 Server($7F0,me,0,nil^); … … 6473 6578 if MyMap[dx] and fTerrain>=fGrass then inc(dy); 6474 6579 dy:=dy 6475 end; *) 6476 'Q': 6477 MenuClick(mResign); 6478 'R': 6479 MenuClick(mRandomMap); 6480 end 6481 else if Shift = [] then 6482 case char(Key) of 6483 char(VK_F1): 6484 MenuClick(mHelp); 6580 end; 6485 6581 end; 6486 exit; 6487 end; 6488 6489 if Shift = [ssAlt] then 6490 case char(Key) of 6491 '0': 6492 SetDebugMap(-1); 6493 '1' .. '9': 6494 SetDebugMap(ord(Key) - 48); 6582 *) 6583 Exit; 6584 end; 6585 6586 if BEndTurn.Test(ShortCut) then EndTurn 6587 else if BFullScreen.Test(ShortCut) then begin 6588 FullScreen := not FullScreen; 6589 SetFullScreen(FullScreen); 6590 end 6591 else if BHelp.Test(ShortCut) then MenuClick(mHelp) 6592 else if BUnitStat.Test(ShortCut) then MenuClick_Check(StatPopup, mUnitStat) 6593 else if BCityStat.Test(ShortCut) then MenuClick_Check(StatPopup, mCityStat) 6594 else if BScienceStat.Test(ShortCut) then MenuClick_Check(StatPopup, mScienceStat) 6595 else if BEUnitStat.Test(ShortCut) then MenuClick_Check(StatPopup, mEUnitStat) 6596 else if BDiagram.Test(ShortCut) then MenuClick_Check(StatPopup, mDiagram) 6597 else if BWonders.Test(ShortCut) then MenuClick_Check(StatPopup, mWonders) 6598 else if BShips.Test(ShortCut) then MenuClick_Check(StatPopup, mShips) 6599 else if BNations.Test(ShortCut) then MenuClick_Check(StatPopup, mNations) 6600 else if BEmpire.Test(ShortCut) then MenuClick_Check(StatPopup, mEmpire) 6601 6602 else if BSetDebugMap0.Test(ShortCut) then SetDebugMap(-1) 6603 else if BSetDebugMap1.Test(ShortCut) then SetDebugMap(1) 6604 else if BSetDebugMap2.Test(ShortCut) then SetDebugMap(2) 6605 else if BSetDebugMap3.Test(ShortCut) then SetDebugMap(3) 6606 else if BSetDebugMap4.Test(ShortCut) then SetDebugMap(4) 6607 else if BSetDebugMap5.Test(ShortCut) then SetDebugMap(5) 6608 else if BSetDebugMap6.Test(ShortCut) then SetDebugMap(6) 6609 else if BSetDebugMap7.Test(ShortCut) then SetDebugMap(7) 6610 else if BSetDebugMap8.Test(ShortCut) then SetDebugMap(8) 6611 else if BSetDebugMap9.Test(ShortCut) then SetDebugMap(9) 6612 6613 else if BJump.Test(ShortCut) then MenuClick(mJump) 6614 else if BDebugMap.Test(ShortCut) then mShowClick(mDebugMap) 6615 else if BLocCodes.Test(ShortCut) then mShowClick(mLocCodes) 6616 else if BLogDlg.Test(ShortCut) then begin 6617 if LogDlg.Visible then LogDlg.Close 6618 else LogDlg.Show; 6619 end 6620 else if BNames.Test(ShortCut) then mNamesClick(mNames) 6621 else if BResign.Test(ShortCut) then MenuClick_Check(GamePopup, mResign) 6622 else if BRun.Test(ShortCut) then MenuClick(mRun) 6623 else if BTestMapRepaint.Test(ShortCut) then begin // test map repaint time 6624 Time0 := NowPrecise; 6625 MapValid := False; 6626 MainOffscreenPaint; 6627 Time1 := NowPrecise; 6628 SimpleMessage(Format('Map repaint time: %.3f ms', 6629 [(Time1 - Time0) / OneMillisecond])); 6630 end 6631 else if BSetViewpoint0.Test(ShortCut) then SetViewpointMe(0) 6632 else if BSetViewpoint1.Test(ShortCut) then SetViewpointMe(1) 6633 else if BSetViewpoint2.Test(ShortCut) then SetViewpointMe(2) 6634 else if BSetViewpoint3.Test(ShortCut) then SetViewpointMe(3) 6635 else if BSetViewpoint4.Test(ShortCut) then SetViewpointMe(4) 6636 else if BSetViewpoint5.Test(ShortCut) then SetViewpointMe(5) 6637 else if BSetViewpoint6.Test(ShortCut) then SetViewpointMe(6) 6638 else if BSetViewpoint7.Test(ShortCut) then SetViewpointMe(7) 6639 else if BSetViewpoint8.Test(ShortCut) then SetViewpointMe(8) 6640 else if BSetViewpoint9.Test(ShortCut) then SetViewpointMe(9) 6641 6642 else if BMapBtn0.Test(ShortCut) then MapBtnClick(MapBtn0) 6643 else if BMapBtn1.Test(ShortCut) then MapBtnClick(MapBtn1) 6644 else if BMapBtn4.Test(ShortCut) then MapBtnClick(MapBtn4) 6645 else if BMapBtn5.Test(ShortCut) then MapBtnClick(MapBtn5) 6646 else if BMapBtn6.Test(ShortCut) then MapBtnClick(MapBtn6) 6647 else if BTechTree.Test(ShortCut) then MenuClick(mTechTree) 6648 else if BWait.Test(ShortCut) then MenuClick(mWait); 6649 6650 if UnFocus >= 0 then begin 6651 if BDisbandUnit.Test(ShortCut) then MenuClick(mDisband) 6652 else if BFortify.Test(ShortCut) then MenuClick_Check(TerrainPopup, mFort) 6653 else if BCenterUnit.Test(ShortCut) then MenuClick(mCentre) 6654 else if BStay.Test(ShortCut) then MenuClick(mStay) 6655 else if BNoOrders.Test(ShortCut) then MenuClick(mNoOrders) 6656 else if BCancel.Test(ShortCut) then MenuClick_Check(UnitPopup, mCancel) 6657 else if BPillage.Test(ShortCut) then MenuClick_Check(UnitPopup, mPillage) 6658 else if BSelectTransport.Test(ShortCut) then MenuClick_Check(UnitPopup, mSelectTransport) 6659 else if BAirBase.Test(ShortCut) then MenuClick_Check(TerrainPopup, mAirBase) 6660 else if BBuildCity.Test(ShortCut) then MenuClick_Check(UnitPopup, mCity) 6661 else if BEnhance.Test(ShortCut) then begin 6662 InitPopup(TerrainPopup); 6663 if mEnhance.Visible and mEnhance.Enabled then MenuClick(mEnhance) 6664 else MenuClick(mEnhanceDef) 6495 6665 end 6496 else if Shift = [ssCtrl] then 6497 case char(Key) of 6498 'J': 6499 MenuClick(mJump); 6500 'K': 6501 mShowClick(mDebugMap); 6502 'L': 6503 mShowClick(mLocCodes); 6504 'M': 6505 if LogDlg.Visible then 6506 LogDlg.Close 6507 else 6508 LogDlg.Show; 6509 'N': 6510 mNamesClick(mNames); 6511 'Q': 6512 MenuClick_Check(GamePopup, mResign); 6513 'R': 6514 MenuClick(mRun); 6515 '0' .. '9': 6516 begin 6517 if ord(Key) - 48 = me then 6518 SetViewpoint(0) 6519 else 6520 SetViewpoint(ord(Key) - 48); 6521 end; 6522 ' ': 6523 begin // test map repaint time 6524 time0 := NowPrecise; 6525 MapValid := false; 6526 MainOffscreenPaint; 6527 time1 := NowPrecise; 6528 SimpleMessage(Format('Map repaint time: %.3f ms', 6529 [(time1 - time0) / OneMillisecond])); 6530 end 6666 else if BGoOn.Test(ShortCut) then MenuClick_Check(UnitPopup, mGoOn) 6667 else if BHome.Test(ShortCut) then MenuClick_Check(UnitPopup, mHome) 6668 else if BFarmClearIrrigation.Test(ShortCut) then begin 6669 if JobTest(UnFocus, jFarm, [eTreaty]) then 6670 MenuClick(mFarm) 6671 else if JobTest(UnFocus, jClear, [eTreaty]) then 6672 MenuClick(mClear) 6673 else MenuClick_Check(TerrainPopup, mIrrigation); 6531 6674 end 6532 else if Shift = [] then 6533 case char(Key) of 6534 char(VK_F1): 6535 MenuClick(mHelp); 6536 char(VK_F2): 6537 MenuClick_Check(StatPopup, mUnitStat); 6538 char(VK_F3): 6539 MenuClick_Check(StatPopup, mCityStat); 6540 char(VK_F4): 6541 MenuClick_Check(StatPopup, mScienceStat); 6542 char(VK_F5): 6543 MenuClick_Check(StatPopup, mEUnitStat); 6544 char(VK_F6): 6545 MenuClick_Check(StatPopup, mDiagram); 6546 char(VK_F7): 6547 MenuClick_Check(StatPopup, mWonders); 6548 char(VK_F8): 6549 MenuClick_Check(StatPopup, mShips); 6550 char(VK_F9): 6551 MenuClick_Check(StatPopup, mNations); 6552 char(VK_F10): 6553 MenuClick_Check(StatPopup, mEmpire); 6554 char(VK_ADD): 6555 EndTurn; 6556 '1': 6557 MapBtnClick(MapBtn0); 6558 '2': 6559 MapBtnClick(MapBtn1); 6560 '3': 6561 MapBtnClick(MapBtn4); 6562 '4': 6563 MapBtnClick(MapBtn5); 6564 '5': 6565 MapBtnClick(MapBtn6); 6566 'T': 6567 MenuClick(mTechTree); 6568 'W': 6569 MenuClick(mWait); 6570 end; 6571 6572 if UnFocus >= 0 then 6573 if Shift = [ssCtrl] then 6574 case char(Key) of 6575 'C': 6576 MenuClick_Check(UnitPopup, mCancel); 6577 'D': 6578 MenuClick(mDisband); 6579 'P': 6580 MenuClick_Check(UnitPopup, mPillage); 6581 'T': 6582 MenuClick_Check(UnitPopup, mSelectTransport); 6583 end 6584 else if Shift = [] then 6585 case char(Key) of 6586 ' ': 6587 MenuClick(mNoOrders); 6588 'A': 6589 MenuClick_Check(TerrainPopup, mAirBase); 6590 'B': 6591 MenuClick_Check(UnitPopup, mCity); 6592 'C': 6593 MenuClick(mCentre); 6594 'E': 6595 begin 6596 InitPopup(TerrainPopup); 6597 if mEnhance.Visible and mEnhance.Enabled then 6598 MenuClick(mEnhance) 6599 else 6600 MenuClick(mEnhanceDef) 6601 end; 6602 'F': 6603 MenuClick_Check(TerrainPopup, mFort); 6604 'G': 6605 MenuClick_Check(UnitPopup, mGoOn); 6606 'H': 6607 MenuClick_Check(UnitPopup, mHome); 6608 'I': 6609 if JobTest(UnFocus, jFarm, [eTreaty]) then 6610 MenuClick(mFarm) 6611 else if JobTest(UnFocus, jClear, [eTreaty]) then 6612 MenuClick(mClear) 6613 else 6614 MenuClick_Check(TerrainPopup, mIrrigation); 6615 'L': 6616 MenuClick_Check(UnitPopup, mLoad); 6617 'M': 6618 if JobTest(UnFocus, jAfforest, [eTreaty]) then 6619 MenuClick(mAfforest) 6620 else 6621 MenuClick_Check(TerrainPopup, mMine); 6622 'N': 6623 MenuClick_Check(TerrainPopup, mCanal); 6624 'O': 6625 MenuClick_Check(TerrainPopup, MTrans); 6626 'P': 6627 MenuClick_Check(TerrainPopup, mPollution); 6628 'R': 6629 if JobTest(UnFocus, jRR, [eTreaty]) then 6630 MenuClick(mRR) 6631 else 6632 MenuClick_Check(TerrainPopup, mRoad); 6633 'S': 6634 MenuClick(mStay); 6635 'U': 6636 MenuClick_Check(UnitPopup, mUnload); 6637 'V': 6638 MenuClick_Check(UnitPopup, mRecover); 6639 'Z': 6640 MenuClick_Check(UnitPopup, mUtilize); 6641 #33 .. #40, #97 .. #100, #102 .. #105: 6642 begin { arrow keys } 6643 DestinationMarkON := false; 6644 PaintDestination; 6645 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 6646 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting; 6647 case Key of 6648 VK_NUMPAD1, VK_END: 6649 begin 6650 dx := -1; 6651 dy := 1 6652 end; 6653 VK_NUMPAD2, VK_DOWN: 6654 begin 6655 dx := 0; 6656 dy := 2 6657 end; 6658 VK_NUMPAD3, VK_NEXT: 6659 begin 6660 dx := 1; 6661 dy := 1 6662 end; 6663 VK_NUMPAD4, VK_LEFT: 6664 begin 6665 dx := -2; 6666 dy := 0 6667 end; 6668 VK_NUMPAD6, VK_RIGHT: 6669 begin 6670 dx := 2; 6671 dy := 0 6672 end; 6673 VK_NUMPAD7, VK_HOME: 6674 begin 6675 dx := -1; 6676 dy := -1 6677 end; 6678 VK_NUMPAD8, VK_UP: 6679 begin 6680 dx := 0; 6681 dy := -2 6682 end; 6683 VK_NUMPAD9, VK_PRIOR: 6684 begin 6685 dx := 1; 6686 dy := -1 6687 end; 6688 end; 6689 MoveUnit(dx, dy, muAutoNext) 6690 end; 6691 end 6675 else if BLoad.Test(ShortCut) then MenuClick_Check(UnitPopup, mLoad) 6676 else if BAfforestMine.Test(ShortCut) then begin 6677 if JobTest(UnFocus, jAfforest, [eTreaty]) then MenuClick(mAfforest) 6678 else MenuClick_Check(TerrainPopup, mMine); 6679 end 6680 else if BCanal.Test(ShortCut) then MenuClick_Check(TerrainPopup, mCanal) 6681 else if BTrans.Test(ShortCut) then MenuClick_Check(TerrainPopup, MTrans) 6682 else if BPollution.Test(ShortCut) then MenuClick_Check(TerrainPopup, mPollution) 6683 else if BRailRoad.Test(ShortCut) then begin 6684 if JobTest(UnFocus, jRR, [eTreaty]) then MenuClick(mRR) 6685 else MenuClick_Check(TerrainPopup, mRoad); 6686 end 6687 else if BUnload.Test(ShortCut) then MenuClick_Check(UnitPopup, mUnload) 6688 else if BRecover.Test(ShortCut) then MenuClick_Check(UnitPopup, mRecover) 6689 else if BUtilize.Test(ShortCut) then MenuClick_Check(UnitPopup, mUtilize) 6690 else if BMoveLeftDown.Test(ShortCut) then DoMoveUnit(-1, 1) 6691 else if BMoveDown.Test(ShortCut) then DoMoveUnit(0, 2) 6692 else if BMoveRightDown.Test(ShortCut) then DoMoveUnit(1, 1) 6693 else if BMoveLeft.Test(ShortCut) then DoMoveUnit(-2, 0) 6694 else if BMoveRight.Test(ShortCut) then DoMoveUnit(2, 0) 6695 else if BMoveLeftUp.Test(ShortCut) then DoMoveUnit(-1, -1) 6696 else if BMoveUp.Test(ShortCut) then DoMoveUnit(0, -2) 6697 else if BMoveRightUp.Test(ShortCut) then DoMoveUnit(1, -1); 6698 end; 6692 6699 end; 6693 6700 … … 7152 7159 SetTroopLoc(Loc); 7153 7160 PanelPaint 7154 end 7161 end; 7155 7162 end 7156 7163 else if Sender = mSelectTransport then … … 7171 7178 begin 7172 7179 HaveCities := true; 7173 Break 7180 Break; 7174 7181 end; 7175 7182 if Popup = GamePopup then … … 7271 7278 m.Checked := true; 7272 7279 mDebugMap.Add(m); 7273 end 7280 end; 7274 7281 end; 7275 7282 mSmallTiles.Checked := xxt = 33; … … 7455 7462 begin 7456 7463 SetTroopLoc(-1); 7457 PanelPaint 7464 PanelPaint; 7458 7465 end 7459 7466 else … … 7474 7481 SetTroopLoc(-1); 7475 7482 PanelPaint 7476 end 7477 end 7483 end; 7484 end; 7478 7485 end; 7479 7486 … … 7523 7530 2 + G.ly); 7524 7531 Update; 7525 end 7532 end; 7526 7533 end 7527 7534 else … … 7539 7546 MiniPaint; 7540 7547 PanelPaint; 7541 end 7548 end; 7542 7549 end; 7543 7550 … … 7591 7598 begin 7592 7599 result := (y >= TopBarHeight + MapHeight) or (y >= ClientHeight - PanelHeight) 7593 and ((x < xMidPanel) or (x >= xRightPanel)) 7600 and ((x < xMidPanel) or (x >= xRightPanel)); 7594 7601 end; 7595 7602 … … 7608 7615 GamePopup.Popup(Left + 4, Top + DpiGetSystemMetrics(SM_CYCAPTION) + 4 + 7609 7616 TopBarHeight - 1); 7610 end 7617 end; 7611 7618 end 7612 7619 else if IsPanelPixel(x, y) then … … 7771 7778 CityRepMask := CityRepMask or (1 shl (Tag shr 8)) 7772 7779 else 7773 CityRepMask := CityRepMask and not(1 shl (Tag shr 8)) 7774 end 7780 CityRepMask := CityRepMask and not(1 shl (Tag shr 8)); 7781 end; 7775 7782 end; 7776 7783 … … 7782 7789 procedure TMainScreen.FormShow(Sender: TObject); 7783 7790 begin 7784 if FullScreen then begin 7785 WindowState := wsFullScreen; 7786 BorderStyle := bsNone; 7787 BorderIcons := []; 7788 end else begin 7789 WindowState := wsMaximized; 7790 BorderStyle := bsSizeable; 7791 BorderIcons := [biSystemMenu, biMinimize, biMaximize]; 7792 end; 7791 SetFullScreen(FullScreen); 7793 7792 Timer1.Enabled := True; 7794 7793 end; … … 7827 7826 else if Flag = tfAllTechs then 7828 7827 TellNewModels 7829 end 7830 end 7828 end; 7829 end; 7831 7830 end; 7832 7831 … … 7898 7897 GamePopup.Popup(Left + 4, Top + DpiGetSystemMetrics(SM_CYCAPTION) + 4 + 7899 7898 TopBarHeight - 1); 7900 exit 7901 end // windows menu button calls game menu7899 exit; 7900 end; // windows menu button calls game menu 7902 7901 end; 7903 7902 -
branches/highdpi/LocalPlayer/Tribes.pas
r210 r303 5 5 6 6 uses 7 Protocol, ScreenTools, LazFileUtils, 8 Classes, Graphics, SysUtils; 7 Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils, Global; 9 8 10 9 type 11 10 TCityPicture = record 12 xShield, yShield: integer; 11 xShield: Integer; 12 yShield: Integer; 13 13 end; 14 14 15 15 TModelPicture = record 16 HGr, pix, xShield, yShield: integer; 16 HGr: Integer; 17 pix: Integer; 18 xShield: Integer; 19 yShield: Integer; 17 20 end; 18 21 19 22 TModelPictureInfo = record 20 trix, mix, pix, Hash: integer; 23 trix: Integer; 24 mix: Integer; 25 pix: Integer; 26 Hash: Integer; 21 27 GrName: ShortString; 22 28 end; 23 29 24 30 TTribe = class 25 symHGr, sympix, faceHGr, facepix, cHGr, cpix, 31 symHGr: Integer; 32 sympix: Integer; 33 faceHGr: Integer; 34 facepix: Integer; 35 cHGr: Integer; 36 cpix: Integer; 26 37 // symbol and city graphics 27 cAge, mixSlaves: integer; 38 cAge: Integer; 39 mixSlaves: Integer; 28 40 Color: TColor; 29 NumberName: integer;41 NumberName: Integer; 30 42 CityPicture: array [0 .. 3] of TCityPicture; 31 43 ModelPicture: array [-1 .. 256] of TModelPicture; // -1 is building site … … 33 45 constructor Create(FileName: string); 34 46 destructor Destroy; override; 35 function GetCityName(i: integer): string;36 {$IFNDEF SCR} procedure SetCityName(i: integer; NewName: string); {$ENDIF}47 function GetCityName(i: Integer): string; 48 {$IFNDEF SCR} procedure SetCityName(i: Integer; NewName: string); {$ENDIF} 37 49 {$IFNDEF SCR} function TString(Template: string): string; 38 50 function TPhrase(Item: string): string; {$ENDIF} 39 procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean);51 procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: Boolean); 40 52 function ChooseModelPicture(var Picture: TModelPictureInfo; 41 code, Turn: integer; ForceNew: boolean): boolean;42 procedure InitAge(Age: integer);53 Code, Turn: Integer; ForceNew: Boolean): Boolean; 54 procedure InitAge(Age: Integer); 43 55 protected 44 CityLine0, nCityLines: integer; 56 CityLine0: Integer; 57 nCityLines: Integer; 45 58 Name: array ['a' .. 'z'] of string; 46 Script: tstringlist;59 Script: TStringList; 47 60 end; 48 61 49 62 var 50 63 Tribe: array [0 .. nPl - 1] of TTribe; 51 HGrStdUnits: integer;64 HGrStdUnits: Integer; 52 65 53 66 procedure Init; 54 67 procedure Done; 55 function CityName(Founder: integer): string; 56 function ModelCode(const ModelInfo: TModelInfo): integer; 57 procedure FindStdModelPicture(code: integer; var pix: integer; 58 var Name: string); 59 function GetTribeInfo(FileName: string; var Name: string; 60 var Color: TColor): boolean; 61 procedure FindPosition(HGr, x, y, xmax, ymax: integer; Mark: TColor; 62 var xp, yp: integer); 68 function CityName(Founder: Integer): string; 69 function ModelCode(const ModelInfo: TModelInfo): Integer; 70 procedure FindStdModelPicture(Code: Integer; var pix: Integer; var Name: string); 71 function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): Boolean; 72 procedure FindPosition(HGr, x, y, xmax, ymax: Integer; Mark: TColor; 73 var xp, yp: Integer); 74 63 75 64 76 implementation … … 69 81 type 70 82 TChosenModelPictureInfo = record 71 Hash, HGr, pix: integer; 72 ModelName: ShortString end; 73 74 TPictureList = array [0 .. 99999] of TChosenModelPictureInfo; 75 76 var 77 StdUnitScript: tstringlist; 78 PictureList: ^TPictureList; 79 nPictureList: integer; 80 81 procedure Init; 82 begin 83 StdUnitScript := tstringlist.Create; 84 StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes' + DirectorySeparator + 'StdUnits.txt')); 85 nPictureList := 0; 86 PictureList := nil; 83 Hash: Integer; 84 HGr: Integer; 85 pix: Integer; 86 ModelName: ShortString; 87 end; 88 89 TPictureList = array [0 .. 99999] of TChosenModelPictureInfo; 90 91 var 92 StdUnitScript: TStringList; 93 PictureList: ^TPictureList; 94 nPictureList: Integer; 95 96 procedure Init; 97 begin 98 StdUnitScript := TStringList.Create; 99 StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes' + 100 DirectorySeparator + 'StdUnits.txt')); 101 nPictureList := 0; 102 PictureList := nil; 103 end; 104 105 procedure Done; 106 begin 107 ReallocMem(PictureList, 0); 108 FreeAndNil(StdUnitScript); 109 end; 110 111 function CityName(Founder: Integer): string; 112 begin 113 if not GenerateNames then 114 Result := Format('%d.%d', [Founder shr 12, Founder and $FFF]) 115 else 116 Result := Tribe[Founder shr 12].GetCityName(Founder and $FFF); 117 end; 118 119 function ModelCode(const ModelInfo: TModelInfo): Integer; 120 begin 121 with ModelInfo do 122 begin 123 case Kind of 124 mkSelfDeveloped, mkEnemyDeveloped: 125 case Domain of { age determination } 126 dGround: 127 if (Attack >= Defense * 4) or (Attack > 0) and 128 (MaxUpgrade < 10) and 129 (Cap and (1 shl (mcArtillery - mcFirstNonCap)) <> 0) then 130 begin 131 Result := 170; 132 if MaxUpgrade >= 12 then 133 Inc(Result, 3) 134 else if (MaxUpgrade >= 10) or (Weight > 7) then 135 Inc(Result, 2) 136 else if MaxUpgrade >= 4 then 137 Inc(Result, 1); 138 end 139 else 140 begin 141 Result := 100; 142 if MaxUpgrade >= 12 then 143 Inc(Result, 6) 144 else if (MaxUpgrade >= 10) or (Weight > 7) then 145 Inc(Result, 5) 146 else if MaxUpgrade >= 6 then 147 Inc(Result, 4) 148 else if MaxUpgrade >= 4 then 149 Inc(Result, 3) 150 else if MaxUpgrade >= 2 then 151 Inc(Result, 2) 152 else if MaxUpgrade >= 1 then 153 Inc(Result, 1); 154 if Speed >= 250 then 155 if (Result >= 105) and (Attack <= Defense) then 156 Result := 110 157 else 158 Inc(Result, 30); 159 end; 160 dSea: 161 begin 162 Result := 200; 163 if MaxUpgrade >= 8 then 164 Inc(Result, 3) 165 else if MaxUpgrade >= 6 then 166 Inc(Result, 2) 167 else if MaxUpgrade >= 3 then 168 Inc(Result, 1); 169 if Cap and (1 shl (mcSub - mcFirstNonCap)) <> 0 then 170 Result := 240 171 else if ATrans_Fuel > 0 then 172 Result := 220 173 else if (Result >= 202) and (Attack = 0) and (TTrans > 0) then 174 Result := 210; 175 end; 176 dAir: 177 begin 178 Result := 300; 179 if (Bombs > 0) or (TTrans > 0) then 180 Inc(Result, 10); 181 if Speed > 850 then 182 Inc(Result, 1); 183 end; 184 end; 185 mkSpecial_TownGuard: 186 Result := 41; 187 mkSpecial_Boat: 188 Result := 64; 189 mkSpecial_SubCabin: 190 Result := 71; 191 mkSpecial_Glider: 192 Result := 73; 193 mkSlaves: 194 Result := 74; 195 mkSettler: 196 if Speed > 150 then 197 Result := 11 198 else 199 Result := 10; 200 mkDiplomat: 201 Result := 21; 202 mkCaravan: 203 Result := 30; 87 204 end; 88 89 procedure Done; 90 begin 91 ReallocMem(PictureList, 0); 92 StdUnitScript.Free; 205 end; 206 end; 207 208 var 209 Input: string; 210 211 function Get: string; 212 var 213 p: Integer; 214 begin 215 while (Input <> '') and ((Input[1] = ' ') or (Input[1] = #9)) do 216 Delete(Input, 1, 1); 217 p := Pos(',', Input); 218 if p = 0 then 219 p := Length(Input) + 1; 220 Result := Copy(Input, 1, p - 1); 221 Delete(Input, 1, p); 222 end; 223 224 function GetNum: Integer; 225 var 226 i: Integer; 227 begin 228 Val(Get, Result, i); 229 if i <> 0 then 230 Result := 0; 231 end; 232 233 procedure FindStdModelPicture(Code: Integer; var pix: Integer; var Name: string); 234 var 235 i: Integer; 236 begin 237 for i := 0 to StdUnitScript.Count - 1 do 238 begin // look through StdUnits 239 Input := StdUnitScript[i]; 240 pix := GetNum; 241 if Code = GetNum then 242 begin 243 Name := Get; 244 Exit; 93 245 end; 94 95 function CityName(Founder: integer): string; 96 begin 97 if not GenerateNames then 98 result := Format('%d.%d', [Founder shr 12, Founder and $FFF]) 246 end; 247 pix := -1; 248 end; 249 250 function GetTribeInfo(FileName: string; var Name: string; 251 var Color: TColor): Boolean; 252 var 253 Found: Integer; 254 TribeScript: TextFile; 255 begin 256 Name := ''; 257 Color := $FFFFFF; 258 Found := 0; 259 AssignFile(TribeScript, LocalizedFilePath('Tribes' + DirectorySeparator + 260 FileName + CevoTribeExt)); 261 Reset(TribeScript); 262 while not EOF(TribeScript) do 263 begin 264 ReadLn(TribeScript, Input); 265 if Copy(Input, 1, 7) = '#CHOOSE' then 266 begin 267 Name := Copy(Input, 9, 255); 268 Found := Found or 1; 269 if Found = 3 then 270 Break; 271 end 272 else if Copy(Input, 1, 6) = '#COLOR' then 273 begin 274 Color := HexStringToColor(Copy(Input, 7, 255)); 275 Found := Found or 2; 276 if Found = 3 then 277 Break; 278 end; 279 end; 280 CloseFile(TribeScript); 281 Result := Found = 3; 282 end; 283 284 constructor TTribe.Create(FileName: string); 285 var 286 Line: Integer; 287 Variant: Char; 288 Item: string; 289 begin 290 inherited Create; 291 for Variant := 'a' to 'z' do 292 Name[Variant] := ''; 293 Script := TStringList.Create; 294 Script.LoadFromFile(FileName); 295 CityLine0 := 0; 296 nCityLines := 0; 297 for Line := 0 to Script.Count - 1 do 298 begin 299 Input := Script[Line]; 300 if (CityLine0 > 0) and (nCityLines = 0) and 301 ((Input = '') or (Input[1] = '#')) then 302 nCityLines := Line - CityLine0; 303 if (Length(Input) >= 3) and (Input[1] = '#') and 304 (Input[2] in ['a' .. 'z']) and (Input[3] = ' ') then 305 Name[Input[2]] := Copy(Input, 4, 255) 306 else if Copy(Input, 1, 6) = '#COLOR' then 307 Color := HexStringToColor(Copy(Input, 7, 255)) 308 else if Copy(Input, 1, 7) = '#CITIES' then 309 CityLine0 := Line + 1 310 else if Copy(Input, 1, 8) = '#SYMBOLS' then 311 begin 312 Delete(Input, 1, 9); 313 Item := Get; 314 sympix := GetNum; 315 symHGr := LoadGraphicSet(Item + '.png'); 316 end; 317 end; 318 FillChar(ModelPicture, SizeOf(ModelPicture), 0); 319 NumberName := -1; 320 cAge := -1; 321 mixSlaves := -1; 322 end; 323 324 destructor TTribe.Destroy; 325 begin 326 FreeAndNil(Script); 327 inherited; 328 end; 329 330 procedure FindPosition(HGr, x, y, xmax, ymax: Integer; Mark: TColor; 331 var xp, yp: Integer); 332 begin 333 xp := 0; 334 while (xp < xmax) and (GrExt[HGr].Data.Canvas.Pixels[x + 1 + xp, y] <> Mark) do 335 Inc(xp); 336 yp := 0; 337 while (yp < ymax) and (GrExt[HGr].Data.Canvas.Pixels[x, y + 1 + yp] <> Mark) do 338 Inc(yp); 339 end; 340 341 function TTribe.GetCityName(i: Integer): string; 342 begin 343 Result := ''; 344 if nCityLines > i then 345 begin 346 Result := Script[CityLine0 + i]; 347 while (Result <> '') and ((Result[1] = ' ') or (Result[1] = #9)) do 348 Delete(Result, 1, 1); 349 end 350 {$IFNDEF SCR} 351 else 352 Result := Format(TPhrase('GENCITY'), [i + 1]); 353 {$ENDIF} 354 end; 355 356 {$IFNDEF SCR} 357 procedure TTribe.SetCityName(i: Integer; NewName: string); 358 begin 359 while nCityLines <= i do 360 begin 361 Script.Insert(CityLine0 + nCityLines, Format(TPhrase('GENCITY'), 362 [nCityLines + 1])); 363 Inc(nCityLines); 364 end; 365 Script[CityLine0 + i] := NewName; 366 end; 367 368 function TTribe.TString(Template: string): string; 369 var 370 p: Integer; 371 Variant: Char; 372 CaseUp: Boolean; 373 begin 374 repeat 375 p := pos('#', Template); 376 if (p = 0) or (p = Length(Template)) then 377 Break; 378 Variant := Template[p + 1]; 379 CaseUp := Variant in ['A' .. 'Z']; 380 if CaseUp then 381 Inc(Variant, 32); 382 Delete(Template, p, 2); 383 if Variant in ['a' .. 'z'] then 384 begin 385 if NumberName < 0 then 386 Insert(Name[Variant], Template, p) 99 387 else 100 result := Tribe[Founder shr 12].GetCityName(Founder and $FFF); 101 end; 102 103 function ModelCode(const ModelInfo: TModelInfo): integer; 104 begin 105 with ModelInfo do 106 begin 107 case Kind of 108 mkSelfDeveloped, mkEnemyDeveloped: 109 case Domain of { age determination } 110 dGround: 111 if (Attack >= Defense * 4) or (Attack > 0) and (MaxUpgrade < 10) 112 and (Cap and (1 shl (mcArtillery - mcFirstNonCap)) <> 0) then 113 begin 114 result := 170; 115 if MaxUpgrade >= 12 then 116 inc(result, 3) 117 else if (MaxUpgrade >= 10) or (Weight > 7) then 118 inc(result, 2) 119 else if MaxUpgrade >= 4 then 120 inc(result, 1) 121 end 122 else 123 begin 124 result := 100; 125 if MaxUpgrade >= 12 then 126 inc(result, 6) 127 else if (MaxUpgrade >= 10) or (Weight > 7) then 128 inc(result, 5) 129 else if MaxUpgrade >= 6 then 130 inc(result, 4) 131 else if MaxUpgrade >= 4 then 132 inc(result, 3) 133 else if MaxUpgrade >= 2 then 134 inc(result, 2) 135 else if MaxUpgrade >= 1 then 136 inc(result, 1); 137 if Speed >= 250 then 138 if (result >= 105) and (Attack <= Defense) then 139 result := 110 140 else 141 inc(result, 30) 142 end; 143 dSea: 144 begin 145 result := 200; 146 if MaxUpgrade >= 8 then 147 inc(result, 3) 148 else if MaxUpgrade >= 6 then 149 inc(result, 2) 150 else if MaxUpgrade >= 3 then 151 inc(result, 1); 152 if Cap and (1 shl (mcSub - mcFirstNonCap)) <> 0 then 153 result := 240 154 else if ATrans_Fuel > 0 then 155 result := 220 156 else if (result >= 202) and (Attack = 0) and (TTrans > 0) then 157 result := 210; 158 end; 159 dAir: 160 begin 161 result := 300; 162 if (Bombs > 0) or (TTrans > 0) then 163 inc(result, 10); 164 if Speed > 850 then 165 inc(result, 1) 166 end; 167 end; 168 mkSpecial_TownGuard: 169 result := 41; 170 mkSpecial_Boat: 171 result := 64; 172 mkSpecial_SubCabin: 173 result := 71; 174 mkSpecial_Glider: 175 result := 73; 176 mkSlaves: 177 result := 74; 178 mkSettler: 179 if Speed > 150 then 180 result := 11 181 else 182 result := 10; 183 mkDiplomat: 184 result := 21; 185 mkCaravan: 186 result := 30; 187 end; 188 end; 189 end; 190 191 var 192 Input: string; 193 194 function Get: string; 195 196 var 197 p: integer; 198 begin 199 while (Input <> '') and ((Input[1] = ' ') or (Input[1] = #9)) do 200 Delete(Input, 1, 1); 201 p := pos(',', Input); 202 if p = 0 then 203 p := Length(Input) + 1; 204 result := Copy(Input, 1, p - 1); 205 Delete(Input, 1, p) 206 end; 207 208 function GetNum: integer; 209 210 var 211 i: integer; 212 begin 213 val(Get, result, i); 214 if i <> 0 then 215 result := 0 216 end; 217 218 procedure FindStdModelPicture(code: integer; var pix: integer; 219 var Name: string); 220 221 var 222 i: integer; 223 begin 224 for i := 0 to StdUnitScript.Count - 1 do 225 begin // look through StdUnits 226 Input := StdUnitScript[i]; 227 pix := GetNum; 228 if code = GetNum then 229 begin 230 Name := Get; 231 exit; 232 end 233 end; 234 pix := -1 235 end; 236 237 function GetTribeInfo(FileName: string; var Name: string; 238 var Color: TColor): boolean; 239 240 var 241 found: integer; 242 TribeScript: TextFile; 243 begin 244 Name := ''; 245 Color := $FFFFFF; 246 found := 0; 247 AssignFile(TribeScript, LocalizedFilePath('Tribes' + DirectorySeparator + FileName + 248 '.tribe.txt')); 249 Reset(TribeScript); 250 while not EOF(TribeScript) do 251 begin 252 ReadLn(TribeScript, Input); 253 if Copy(Input, 1, 7) = '#CHOOSE' then 254 begin 255 Name := Copy(Input, 9, 255); 256 found := found or 1; 257 if found = 3 then 258 break 259 end 260 else if Copy(Input, 1, 6) = '#COLOR' then 261 begin 262 Color := HexStringToColor(Copy(Input, 7, 255)); 263 found := found or 2; 264 if found = 3 then 265 break 266 end 267 end; 268 CloseFile(TribeScript); 269 result := found = 3; 270 end; 271 272 constructor TTribe.Create(FileName: string); 273 274 var 275 line: integer; 276 variant: char; 277 Item: string; 278 begin 279 inherited Create; 280 for variant := 'a' to 'z' do 281 Name[variant] := ''; 282 Script := tstringlist.Create; 283 Script.LoadFromFile(LocalizedFilePath('Tribes' + DirectorySeparator + FileName + '.tribe.txt')); 284 CityLine0 := 0; 285 nCityLines := 0; 286 for line := 0 to Script.Count - 1 do 287 begin 288 Input := Script[line]; 289 if (CityLine0 > 0) and (nCityLines = 0) and 290 ((Input = '') or (Input[1] = '#')) then 291 nCityLines := line - CityLine0; 292 if (Length(Input) >= 3) and (Input[1] = '#') and (Input[2] in ['a' .. 'z'] 293 ) and (Input[3] = ' ') then 294 Name[Input[2]] := Copy(Input, 4, 255) 295 else if Copy(Input, 1, 6) = '#COLOR' then 296 Color := HexStringToColor(Copy(Input, 7, 255)) 297 else if Copy(Input, 1, 7) = '#CITIES' then 298 CityLine0 := line + 1 299 else if Copy(Input, 1, 8) = '#SYMBOLS' then 300 begin 301 Delete(Input, 1, 9); 302 Item := Get; 303 sympix := GetNum; 304 symHGr := LoadGraphicSet(Item + '.png'); 305 end 306 end; 307 FillChar(ModelPicture, SizeOf(ModelPicture), 0); 308 NumberName := -1; 309 cAge := -1; 310 mixSlaves := -1; 311 end; 312 313 destructor TTribe.Destroy; 314 begin 315 Script.Free; 316 inherited Destroy; 317 end; 318 319 procedure FindPosition(HGr, x, y, xmax, ymax: integer; Mark: TColor; 320 var xp, yp: integer); 321 begin 322 xp := 0; 323 while (xp < xmax) and (GrExt[HGr].Data.Canvas.Pixels[x + 1 + xp, y] 324 <> Mark) do 325 inc(xp); 326 yp := 0; 327 while (yp < ymax) and (GrExt[HGr].Data.Canvas.Pixels[x, y + 1 + yp] 328 <> Mark) do 329 inc(yp); 330 end; 331 332 function TTribe.GetCityName(i: integer): string; 333 begin 334 result := ''; 335 if nCityLines > i then 336 begin 337 result := Script[CityLine0 + i]; 338 while (result <> '') and ((result[1] = ' ') or (result[1] = #9)) do 339 Delete(result, 1, 1); 388 Insert(Format('P%d', [NumberName]), Template, p); 389 if CaseUp and (Length(Template) >= p) and 390 (Template[p] in ['a' .. 'z', #$E0 .. #$FF]) then 391 Dec(Template[p], 32); 340 392 end 341 {$IFNDEF SCR} else 342 result := Format(TPhrase('GENCITY'), [i + 1]){$ENDIF} 343 end; 344 345 {$IFNDEF SCR} 346 procedure TTribe.SetCityName(i: integer; NewName: string); 347 begin 348 while nCityLines <= i do 349 begin 350 Script.Insert(CityLine0 + nCityLines, Format(TPhrase('GENCITY'), 351 [nCityLines + 1])); 352 inc(nCityLines); 353 end; 354 Script[CityLine0 + i] := NewName; 355 end; 356 357 function TTribe.TString(Template: string): string; 358 359 var 360 p: integer; 361 variant: char; 362 CaseUp: boolean; 363 begin 364 repeat 365 p := pos('#', Template); 366 if (p = 0) or (p = Length(Template)) then 367 break; 368 variant := Template[p + 1]; 369 CaseUp := variant in ['A' .. 'Z']; 370 if CaseUp then 371 inc(variant, 32); 372 Delete(Template, p, 2); 373 if variant in ['a' .. 'z'] then 374 begin 375 if NumberName < 0 then 376 Insert(Name[variant], Template, p) 377 else 378 Insert(Format('P%d', [NumberName]), Template, p); 379 if CaseUp and (Length(Template) >= p) and 380 (Template[p] in ['a' .. 'z', #$E0 .. #$FF]) then 381 dec(Template[p], 32); 382 end 383 until false; 384 result := Template; 385 end; 386 387 function TTribe.TPhrase(Item: string): string; 388 begin 389 result := TString(Phrases.Lookup(Item)); 390 end; 393 until False; 394 Result := Template; 395 end; 396 397 function TTribe.TPhrase(Item: string): string; 398 begin 399 Result := TString(Phrases.Lookup(Item)); 400 end; 401 391 402 {$ENDIF} 392 403 393 procedure TTribe.InitAge(Age: integer); 394 type 395 TLine = array [0 .. 649, 0 .. 2] of Byte; 396 var 397 i, x, gray: integer; 398 Item: string; 399 begin 400 if Age = cAge then 401 exit; 402 cAge := Age; 403 with Script do 404 begin 405 i := 0; 406 while (i < Count) and 407 (Copy(Strings[i], 1, 6) <> '#AGE' + char(48 + Age) + ' ') do 408 inc(i); 409 if i < Count then 410 begin 411 Input := Strings[i]; 412 system.Delete(Input, 1, 6); 413 Item := Get; 414 cpix := GetNum; 415 // init city graphics 416 if Age < 2 then 417 begin 418 if CompareText(Item, 'stdcities') = 0 then 419 case cpix of 420 3: 421 cpix := 0; 422 6: 423 begin 424 cpix := 0; 425 Item := 'Nation2'; 426 end 427 end; 428 cHGr := LoadGraphicSet(Item + '.png'); 429 for x := 0 to 3 do 430 with CityPicture[x] do 431 begin 432 FindPosition(cHGr, x * 65, cpix * 49, 63, 47, $00FFFF, 433 xShield, yShield); 434 // FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf); 435 end 436 end 437 else 438 cHGr := -1; 439 440 {$IFNDEF SCR} 441 Get; 442 GetNum; 443 Item := Get; 444 if Item = '' then 445 faceHGr := -1 446 else 447 begin 448 faceHGr := LoadGraphicSet(Item + '.png'); 449 facepix := GetNum; 450 if GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65, 451 facepix div 10 * 49 + 48] = $00FFFF then 452 begin // generate shield picture 453 GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65, 454 facepix div 10 * 49 + 48] := $000000; 455 gray := $B8B8B8; 456 ImageOp_BCC(GrExt[faceHGr].Data, Templates, 457 facepix mod 10 * 65 + 1, facepix div 10 * 49 + 1, 1, 25, 64, 48, 458 gray, Color); 404 procedure TTribe.InitAge(Age: Integer); 405 type 406 TLine = array [0 .. 649, 0 .. 2] of Byte; 407 var 408 i, x, Gray: Integer; 409 Item: string; 410 begin 411 if Age = cAge then 412 Exit; 413 cAge := Age; 414 with Script do 415 begin 416 i := 0; 417 while (i < Count) and (Copy(Strings[i], 1, 6) <> 418 '#AGE' + char(48 + Age) + ' ') do 419 Inc(i); 420 if i < Count then 421 begin 422 Input := Strings[i]; 423 system.Delete(Input, 1, 6); 424 Item := Get; 425 cpix := GetNum; 426 // init city graphics 427 if Age < 2 then 428 begin 429 if CompareText(Item, 'stdcities') = 0 then 430 case cpix of 431 3: 432 cpix := 0; 433 6: 434 begin 435 cpix := 0; 436 Item := 'Nation2'; 459 437 end 460 438 end; 439 cHGr := LoadGraphicSet(Item + '.png'); 440 for x := 0 to 3 do 441 with CityPicture[x] do 442 begin 443 FindPosition(cHGr, x * 65, cpix * 49, 63, 47, $00FFFF, 444 xShield, yShield); 445 // FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf); 446 end; 447 end 448 else 449 cHGr := -1; 450 451 {$IFNDEF SCR} 452 Get; 453 GetNum; 454 Item := Get; 455 if Item = '' then 456 faceHGr := -1 457 else 458 begin 459 faceHGr := LoadGraphicSet(Item + '.png'); 460 facepix := GetNum; 461 if GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65, 462 facepix div 10 * 49 + 48] = $00FFFF then 463 begin // generate shield picture 464 GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65, 465 facepix div 10 * 49 + 48] := $000000; 466 Gray := $B8B8B8; 467 ImageOp_BCC(GrExt[faceHGr].Data, Templates, 468 facepix mod 10 * 65 + 1, facepix div 10 * 49 + 1, 1, 25, 64, 48, 469 Gray, Color); 470 end; 471 end; 461 472 {$ENDIF} 462 end463 end464 473 end; 465 466 procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; 467 IsNew: boolean); 468 var 469 i: integer; 470 ok: boolean; 471 begin 472 with Info do 473 begin 474 if not IsNew then 474 end; 475 end; 476 477 procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; IsNew: Boolean); 478 var 479 i: Integer; 480 ok: Boolean; 481 begin 482 with Info do 483 begin 484 if not IsNew then 485 begin 486 i := nPictureList - 1; 487 while (i >= 0) and (PictureList[i].Hash <> Info.Hash) do 488 Dec(i); 489 assert(i >= 0); 490 assert(PictureList[i].HGr = LoadGraphicSet(GrName)); 491 assert(PictureList[i].pix = pix); 492 ModelPicture[mix].HGr := PictureList[i].HGr; 493 ModelPicture[mix].pix := PictureList[i].pix; 494 ModelName[mix] := PictureList[i].ModelName; 495 end 496 else 497 begin 498 with ModelPicture[mix] do 499 begin 500 HGr := LoadGraphicSet(GrName); 501 pix := Info.pix; 502 Inc(GrExt[HGr].pixUsed[pix]); 503 end; 504 ModelName[mix] := ''; 505 506 // read model name from tribe script 507 ok := False; 508 for i := 0 to Script.Count - 1 do 509 begin 510 Input := Script[i]; 511 if Input = '#UNITS ' + ExtractFileNameOnly(GrName) then 512 ok := True 513 else if (Input <> '') and (Input[1] = '#') then 514 ok := False 515 else if ok and (GetNum = pix) then 475 516 begin 476 i := nPictureList - 1; 477 while (i >= 0) and (PictureList[i].Hash <> Info.Hash) do 478 dec(i); 479 assert(i >= 0); 480 assert(PictureList[i].HGr = LoadGraphicSet(GrName)); 481 assert(PictureList[i].pix = pix); 482 ModelPicture[mix].HGr := PictureList[i].HGr; 483 ModelPicture[mix].pix := PictureList[i].pix; 484 ModelName[mix] := PictureList[i].ModelName; 485 end 486 else 517 Get; 518 ModelName[mix] := Get; 519 end; 520 end; 521 522 if ModelName[mix] = '' then 523 begin // read model name from StdUnits.txt 524 for i := 0 to StdUnitScript.Count - 1 do 487 525 begin 488 with ModelPicture[mix] do 526 Input := StdUnitScript[i]; 527 if GetNum = pix then 489 528 begin 490 HGr := LoadGraphicSet(GrName); 491 pix := Info.pix; 492 inc(GrExt[HGr].pixUsed[pix]); 529 Get; 530 ModelName[mix] := Get; 493 531 end; 494 ModelName[mix] := '';495 496 // read model name from tribe script497 ok := false;498 for i := 0 to Script.Count - 1 do499 begin500 Input := Script[i];501 if Input = '#UNITS ' + ExtractFileNameOnly(GrName) then502 ok := true503 else if (Input <> '') and (Input[1] = '#') then504 ok := false505 else if ok and (GetNum = pix) then506 begin507 Get;508 ModelName[mix] := Get509 end510 end;511 512 if ModelName[mix] = '' then513 begin // read model name from StdUnits.txt514 for i := 0 to StdUnitScript.Count - 1 do515 begin516 Input := StdUnitScript[i];517 if GetNum = pix then518 begin519 Get;520 ModelName[mix] := Get521 end522 end523 end;524 525 if Hash <> 0 then526 begin527 if nPictureList = 0 then528 ReallocMem(PictureList, 64 * SizeOf(TChosenModelPictureInfo))529 else if (nPictureList >= 64) and530 (nPictureList and (nPictureList - 1) = 0) then531 ReallocMem(PictureList,532 nPictureList * (2 * SizeOf(TChosenModelPictureInfo)));533 PictureList[nPictureList].Hash := Info.Hash;534 PictureList[nPictureList].HGr := ModelPicture[mix].HGr;535 PictureList[nPictureList].pix := Info.pix;536 PictureList[nPictureList].ModelName := ModelName[mix];537 inc(nPictureList);538 end539 532 end; 540 541 with ModelPicture[mix] do 542 FindPosition(HGr, pix mod 10 * 65, pix div 10 * 49, 63, 47, $FFFFFF, 543 xShield, yShield); 533 end; 534 535 if Hash <> 0 then 536 begin 537 if nPictureList = 0 then 538 ReallocMem(PictureList, 64 * SizeOf(TChosenModelPictureInfo)) 539 else if (nPictureList >= 64) and (nPictureList and 540 (nPictureList - 1) = 0) then 541 ReallocMem(PictureList, 542 nPictureList * (2 * SizeOf(TChosenModelPictureInfo))); 543 PictureList[nPictureList].Hash := Info.Hash; 544 PictureList[nPictureList].HGr := ModelPicture[mix].HGr; 545 PictureList[nPictureList].pix := Info.pix; 546 PictureList[nPictureList].ModelName := ModelName[mix]; 547 Inc(nPictureList); 544 548 end; 545 549 end; 546 550 547 function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo; 548 code, Turn: integer; ForceNew: boolean): boolean; 549 var 550 i, Cnt, HGr, used, LeastUsed: integer; 551 TestPic: TModelPictureInfo; 552 ok: boolean; 553 554 procedure check; 555 begin 556 TestPic.pix := GetNum; 557 if code = GetNum then 558 begin 559 if ForceNew or (HGr < 0) then 560 used := 0 561 else 562 begin 563 used := 4 * GrExt[HGr].pixUsed[TestPic.pix]; 564 if HGr = HGrStdUnits then 565 inc(used, 2); // prefer units not from StdUnits 566 end; 567 if used < LeastUsed then 568 begin 569 Cnt := 0; 570 LeastUsed := used 571 end; 572 if used = LeastUsed then 573 begin 574 inc(Cnt); 575 if Turn mod Cnt = 0 then 576 Picture := TestPic 577 end; 578 end 579 end; 580 581 begin 582 // look for identical model to assign same picture again 583 if not ForceNew and (Picture.Hash > 0) then 584 begin 585 for i := 0 to nPictureList - 1 do 586 if PictureList[i].Hash = Picture.Hash then 587 begin 588 Picture.GrName := GrExt[PictureList[i].HGr].Name; 589 Picture.pix := PictureList[i].pix; 590 result := false; 591 exit; 592 end 593 end; 594 595 Picture.pix := 0; 596 TestPic := Picture; 597 LeastUsed := MaxInt; 598 599 TestPic.GrName := 'StdUnits.png'; 600 HGr := HGrStdUnits; 601 for i := 0 to StdUnitScript.Count - 1 do 602 begin // look through StdUnits 603 Input := StdUnitScript[i]; 604 check; 605 end; 606 607 ok := false; 608 for i := 0 to Script.Count - 1 do 609 begin // look through units defined in tribe script 610 Input := Script[i]; 611 if Copy(Input, 1, 6) = '#UNITS' then 612 begin 613 ok := true; 614 TestPic.GrName := Copy(Input, 8, 255) + '.png'; 615 HGr := nGrExt - 1; 616 while (HGr >= 0) and (GrExt[HGr].Name <> TestPic.GrName) do 617 dec(HGr); 618 end 619 else if (Input <> '') and (Input[1] = '#') then 620 ok := false 621 else if ok then 622 check; 623 end; 624 result := true; 551 with ModelPicture[mix] do 552 FindPosition(HGr, pix mod 10 * 65, pix div 10 * 49, 63, 47, $FFFFFF, 553 xShield, yShield); 554 end; 555 end; 556 557 function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo; 558 Code, Turn: Integer; ForceNew: Boolean): Boolean; 559 var 560 i, Cnt, HGr, Used, LeastUsed: Integer; 561 TestPic: TModelPictureInfo; 562 ok: Boolean; 563 564 procedure Check; 565 begin 566 TestPic.pix := GetNum; 567 if Code = GetNum then 568 begin 569 if ForceNew or (HGr < 0) then 570 Used := 0 571 else 572 begin 573 Used := 4 * GrExt[HGr].pixUsed[TestPic.pix]; 574 if HGr = HGrStdUnits then 575 Inc(Used, 2); // prefer units not from StdUnits 576 end; 577 if Used < LeastUsed then 578 begin 579 Cnt := 0; 580 LeastUsed := Used; 581 end; 582 if Used = LeastUsed then 583 begin 584 Inc(Cnt); 585 if Turn mod Cnt = 0 then 586 Picture := TestPic; 587 end; 625 588 end; 589 end; 590 591 begin 592 // look for identical model to assign same picture again 593 if not ForceNew and (Picture.Hash > 0) then 594 begin 595 for i := 0 to nPictureList - 1 do 596 if PictureList[i].Hash = Picture.Hash then 597 begin 598 Picture.GrName := GrExt[PictureList[i].HGr].Name; 599 Picture.pix := PictureList[i].pix; 600 Result := False; 601 Exit; 602 end; 603 end; 604 605 Picture.pix := 0; 606 TestPic := Picture; 607 LeastUsed := MaxInt; 608 609 TestPic.GrName := 'StdUnits.png'; 610 HGr := HGrStdUnits; 611 for i := 0 to StdUnitScript.Count - 1 do 612 begin // look through StdUnits 613 Input := StdUnitScript[i]; 614 Check; 615 end; 616 617 ok := False; 618 for i := 0 to Script.Count - 1 do 619 begin // look through units defined in tribe script 620 Input := Script[i]; 621 if Copy(Input, 1, 6) = '#UNITS' then 622 begin 623 ok := True; 624 TestPic.GrName := Copy(Input, 8, 255) + '.png'; 625 HGr := nGrExt - 1; 626 while (HGr >= 0) and (GrExt[HGr].Name <> TestPic.GrName) do 627 Dec(HGr); 628 end 629 else if (Input <> '') and (Input[1] = '#') then 630 ok := False 631 else if ok then 632 Check; 633 end; 634 Result := True; 635 end; 626 636 627 637 end. -
branches/highdpi/LocalPlayer/UnitStat.pas
r210 r303 83 83 Template := TDpiBitmap.Create; 84 84 Template.PixelFormat := pf24bit; 85 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Unit.png', gfNoGamma); 85 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Unit.png', 86 [gfNoGamma]); 86 87 end; 87 88 88 89 procedure TUnitStatDlg.FormDestroy(Sender: TObject); 89 90 begin 90 Template.Free;91 Back.Free;91 FreeAndNil(Template); 92 FreeAndNil(Back); 92 93 end; 93 94 … … 276 277 procedure TUnitStatDlg.CloseBtnClick(Sender: TObject); 277 278 begin 278 Close 279 Close; 279 280 end; 280 281 … … 363 364 inc(dx, 15) 364 365 end; 365 end 366 end 366 end; 367 end; 367 368 end; { featurebar } 368 369 -
branches/highdpi/NoTerm.pas
r210 r303 25 25 G: TNewGameData; 26 26 Server: TServerCall; 27 Shade, State: TDpiBitmap; 27 Shade: TDpiBitmap; 28 State: TDpiBitmap; 28 29 WinStat, ExtStat, AloneStat: array [0 .. nPl - 1] of integer; 29 30 DisallowShowActive: array [0 .. nPl - 1] of boolean; … … 163 164 cReleaseModule: 164 165 begin 165 Shade.Free;166 State.Free;166 FreeAndNil(Shade); 167 FreeAndNil(State); 167 168 end; 168 169 … … 245 246 ShipComplete := false; 246 247 if ShipComplete then 247 inc(WinStat[p]) 248 inc(WinStat[p]); 248 249 end; 249 250 if Mode = Running then … … 255 256 begin 256 257 GoBtn.ButtonIndex := 22; 257 Mode := Stopped 258 end 258 Mode := Stopped; 259 end; 259 260 end; 260 261 … … 277 278 if (Active >= 0) and not DisallowShowActive[Active] then 278 279 ShowActive(Active, true); 279 end 280 281 end 280 end; 281 end; 282 282 end; 283 283 … … 292 292 GoBtn.Update; 293 293 Server(sTurn, me, 0, nil^); 294 end 294 end; 295 295 end; 296 296 … … 300 300 EndPlaying 301 301 else 302 Mode := Quit 302 Mode := Quit; 303 303 end; 304 304 -
branches/highdpi/Packages/CevoComponents/ButtonA.pas
r210 r303 35 35 constructor TButtonA.Create(aOwner: TComponent); 36 36 begin 37 inherited Create(aOwner);37 inherited; 38 38 FCaption := ''; 39 39 SetBounds(0, 0, 100, 25); -
branches/highdpi/Packages/CevoComponents/ButtonB.pas
r210 r303 38 38 constructor TButtonB.Create(aOwner: TComponent); 39 39 begin 40 inherited Create(aOwner);40 inherited; 41 41 ShowHint := True; 42 42 SetBounds(0, 0, 25, 25); -
branches/highdpi/Packages/CevoComponents/ButtonC.pas
r210 r303 32 32 constructor TButtonC.Create(aOwner: TComponent); 33 33 begin 34 inherited Create(aOwner);34 inherited; 35 35 ShowHint := True; 36 36 SetBounds(0, 0, 12, 12); -
branches/highdpi/Packages/CevoComponents/ButtonN.pas
r210 r303 45 45 constructor TButtonN.Create(aOwner: TComponent); 46 46 begin 47 inherited Create(aOwner);47 inherited; 48 48 ShowHint := true; 49 49 FGraphic := nil; -
branches/highdpi/Packages/CevoComponents/CevoComponents.lpk
r246 r303 37 37 <Description Value="C-evo components"/> 38 38 <Version Major="1" Minor="2"/> 39 <Files Count="1 4">39 <Files Count="15"> 40 40 <Item1> 41 41 <Filename Value="Area.pas"/> … … 102 102 <UnitName Value="UPixelPointer"/> 103 103 </Item14> 104 <Item15> 105 <Filename Value="AsyncProcess2.pas"/> 106 <UnitName Value="AsyncProcess2"/> 107 </Item15> 104 108 </Files> 105 109 <RequiredPkgs Count="3"> -
branches/highdpi/Packages/CevoComponents/CevoComponents.pas
r210 r303 10 10 uses 11 11 Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg, 12 Sound, BaseWin, UPixelPointer, LazarusPackageIntf;12 Sound, BaseWin, UPixelPointer, AsyncProcess2, LazarusPackageIntf; 13 13 14 14 implementation -
branches/highdpi/Packages/CevoComponents/DrawDlg.pas
r252 r303 18 18 MoveActive: Boolean; 19 19 procedure VisibleChangedHandler(Sender: TObject); 20 procedure DoDeactivate(Sender: TObject); 20 21 protected 21 22 TitleHeight: Integer; … … 29 30 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 30 31 procedure MouseLeave; override; 32 procedure KeyDown(var Key: Word; Shift: TShiftState); override; 31 33 public 32 34 constructor Create(AOwner: TComponent); override; … … 71 73 MoveActive := False; 72 74 AddHandlerOnVisibleChanged(VisibleChangedHandler); 75 {$IFDEF LINUX} 76 OnDeactivate := DoDeactivate; 77 {$ENDIF} 73 78 end; 74 79 … … 76 81 begin 77 82 RemoveHandlerOnVisibleChanged(VisibleChangedHandler); 78 inherited Destroy;83 inherited; 79 84 end; 80 85 … … 171 176 end; 172 177 178 procedure TDrawDlg.KeyDown(var Key: Word; Shift: TShiftState); 179 begin 180 if Key = VK_ESCAPE then Close; 181 inherited; 182 end; 183 173 184 procedure TDrawDlg.VisibleChangedHandler(Sender: TObject); 185 begin 186 MoveActive := False; 187 end; 188 189 procedure TDrawDlg.DoDeactivate(Sender: TObject); 174 190 begin 175 191 MoveActive := False; -
branches/highdpi/Packages/CevoComponents/ScreenTools.pas
r266 r303 13 13 TTexture = record 14 14 Image: TDpiBitmap; 15 clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark, 16 clPage, clCover: TColor; 17 end; 15 clBevelLight: TColor; 16 clBevelShade: TColor; 17 clTextLight: TColor; 18 clTextShade: TColor; 19 clLitText: TColor; 20 clMark: TColor; 21 clPage: TColor; 22 clCover: TColor; 23 end; 24 TLoadGraphicFileOption = (gfNoError, gfNoGamma); 25 TLoadGraphicFileOptions = set of TLoadGraphicFileOption; 26 18 27 19 28 {$IFDEF WINDOWS} … … 28 37 procedure EditFrame(ca: TDpiCanvas; p: TRect; const T: TTexture); 29 38 function HexStringToColor(S: string): integer; 30 function LoadGraphicFile( bmp: TDpiBitmap; Path: string; Options: integer = 0): boolean;39 function LoadGraphicFile(Bmp: TDpiBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean; 31 40 function LoadGraphicSet(const Name: string): integer; 32 41 procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); … … 91 100 function SetMainTextureByAge(Age: integer): boolean; 92 101 procedure LoadPhrases; 93 procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Integer);102 procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Cardinal); 94 103 procedure DarkenImage(Bitmap: TDpiBitmap; Change: Integer); 95 104 … … 158 167 cliWater = 4; 159 168 160 // LoadGraphicFile options161 gfNoError = $01;162 gfNoGamma = $02;163 164 169 type 165 170 TGrExtDescr = record { don't use dynamic strings here! } … … 256 261 MenuItem := MenuItems[MenuItems.Count - 1]; 257 262 MenuItems.Delete(MenuItems.Count - 1); 258 MenuItem.Free;263 FreeAndNil(MenuItem); 259 264 end; 260 265 end; 261 266 262 267 function TurnToYear(Turn: Integer): Integer; 263 var264 I: Integer;265 268 begin 266 269 Result := -4000; 267 for I := 1 to Turn do 268 if Result < -1000 then Inc(Result, 50) // 0..60 269 else if Result < 0 then Inc(Result, 25) // 60..100 270 else if Result < 1500 then Inc(Result, 20) // 100..175 271 else if Result < 1750 then Inc(Result, 10) // 175..200 272 else if Result < 1850 then Inc(Result, 2) // 200..250 273 else Inc(Result); 270 if Turn <= 0 then Exit; 271 272 // Year -4000..-1000, Turn 0..60 273 Inc(Result, Min(60, Turn) * 50); 274 Dec(Turn, Min(60, Turn)); 275 if Turn = 0 then Exit; 276 277 // Year -1000..0, Turn 60..100 278 Inc(Result, Min(40, Turn) * 25); 279 Dec(Turn, Min(40, Turn)); 280 if Turn = 0 then Exit; 281 282 // Year 0..1500, Turn 100..175 283 Inc(Result, Min(75, Turn) * 20); 284 Dec(Turn, Min(75, Turn)); 285 if Turn = 0 then Exit; 286 287 // Year 1500..1750, Turn 175..200 288 Inc(Result, Min(25, Turn) * 10); 289 Dec(Turn, Min(25, Turn)); 290 if Turn = 0 then Exit; 291 292 // Year 1750..1850, Turn 200..250 293 Inc(Result, Min(50, Turn) * 2); 294 Dec(Turn, Min(50, Turn)); 295 if Turn = 0 then Exit; 296 297 // Year 1850.., Turn 250.. 298 Inc(Result, Turn); 274 299 end; 275 300 … … 395 420 end; 396 421 397 function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: Integer): Boolean; 398 var 399 jtex: TDpiJpegImage; 422 function LoadGraphicFile(Bmp: TDpiBitmap; FileName: string; Options: 423 TLoadGraphicFileOptions = []): Boolean; 424 var 425 Jpeg: TDpiJpegImage; 400 426 Png: TDpiPortableNetworkGraphic; 401 427 begin 402 Result := True; 403 if ExtractFileExt(Path) = '' then 404 Path := Path + '.png'; 405 if ExtractFileExt(Path) = '.jpg' then begin 406 jtex := TDpiJpegImage.Create; 407 try 428 Result := False; 429 if ExtractFileExt(FileName) = '' then 430 FileName := FileName + '.png'; 431 432 if FileExists(FileName) then begin 433 if ExtractFileExt(FileName) = '.jpg' then begin 434 Jpeg := TDpiJpegImage.Create; 408 435 try 409 jtex.LoadFromFile(Path); 436 Jpeg.LoadFromFile(FileName); 437 if not (gfNoGamma in Options) then 438 Bmp.PixelFormat := pf24bit; 439 Bmp.SetSize(Jpeg.Width, Jpeg.Height); 440 Bmp.Canvas.Draw(0, 0, Jpeg); 441 Result := True; 410 442 except 411 443 Result := False; 412 444 end; 413 if Result then 414 begin 415 if Options and gfNoGamma = 0 then 416 bmp.PixelFormat := pf24bit; 417 Bmp.SetSize(jtex.Width, jtex.Height); 418 Bmp.Canvas.Draw(0, 0, jtex); 419 end; 420 finally 421 FreeAndNil(jtex); 422 end; 423 end 424 else 425 if ExtractFileExt(Path) = '.png' then begin 426 Png := TDpiPortableNetworkGraphic.Create; 427 try 428 Png.PixelFormat := Bmp.PixelFormat; 445 FreeAndNil(Jpeg); 446 end else 447 if ExtractFileExt(FileName) = '.png' then begin 448 Png := TDpiPortableNetworkGraphic.Create; 429 449 try 430 Png.LoadFromFile(Path); 431 except 432 Result := False; 433 end; 434 if Result then begin 435 if Options and gfNoGamma = 0 then 436 bmp.PixelFormat := pf24bit; 437 bmp.SetSize(Png.Width, Png.Height); 450 Png.PixelFormat := Bmp.PixelFormat; 451 Png.LoadFromFile(FileName); 452 if not (gfNoGamma in Options) then 453 Bmp.PixelFormat := pf24bit; 454 Bmp.SetSize(Png.Width, Png.Height); 438 455 if (Png.RawImage.Description.Format = ricfGray) then 439 456 begin … … 441 458 Bmp.PixelFormat := pf24bit; 442 459 CopyGray8BitTo24bitBitmap(Bmp, Png); 443 end else 444 Bmp.Canvas.draw(0, 0, Png); 460 end 461 else 462 Bmp.Canvas.Draw(0, 0, Png); 463 Result := True; 464 except 465 Result := False; 445 466 end; 446 finally447 467 FreeAndNil(Png); 448 end; 449 end else 450 if ExtractFileExt(Path) = '.bmp' then begin 451 try 452 bmp.LoadFromFile(Path); 453 except 454 Result := False; 455 end; 456 if Result then begin 457 if Options and gfNoGamma = 0 then 458 bmp.PixelFormat := pf24bit; 459 end; 460 end else 461 raise Exception.Create('Unsupported image file type ' + ExtractFileExt(Path)); 468 end else 469 if ExtractFileExt(FileName) = '.bmp' then begin 470 try 471 Bmp.LoadFromFile(FileName); 472 if not (gfNoGamma in Options) then 473 Bmp.PixelFormat := pf24bit; 474 Result := True; 475 except 476 Result := False; 477 end; 478 end else 479 raise Exception.Create('Unsupported image file type ' + ExtractFileExt(FileName)); 480 end; 462 481 463 482 if not Result then begin 464 if Options and gfNoError = 0then465 raise Exception.Create(Format(Phrases.Lookup('FILENOTFOUND'), [ Path]));466 end; 467 468 if ( Options and gfNoGamma = 0) and (Gamma <> 100) then483 if not (gfNoError in Options) then 484 raise Exception.Create(Format(Phrases.Lookup('FILENOTFOUND'), [FileName])); 485 end; 486 487 if (not (gfNoGamma in Options)) and (Gamma <> 100) then 469 488 ApplyGammaToBitmap(Bmp); 470 489 end; … … 1247 1266 i, r, g, b: Integer; 1248 1267 begin 1249 begin 1250 for i := 0 to 15 do 1251 begin // gradient 1252 r := Color and $FF + Brightness[i]; 1253 if r < 0 then 1254 r := 0 1255 else if r >= 256 then 1256 r := 255; 1257 g := Color shr 8 and $FF + Brightness[i]; 1258 if g < 0 then 1259 g := 0 1260 else if g >= 256 then 1261 g := 255; 1262 b := Color shr 16 and $FF + Brightness[i]; 1263 if b < 0 then 1264 b := 0 1265 else if b >= 256 then 1266 b := 255; 1267 ca.Pen.Color := r + g shl 8 + b shl 16; 1268 ca.MoveTo(x + dx * i, y + dy * i); 1269 ca.LineTo(x + dx * i + Width, y + dy * i + Height); 1270 end; 1271 ca.Pen.Color := $000000; 1272 ca.MoveTo(x + 1, y + 16 * dy + Height); 1273 ca.LineTo(x + 16 * dx + Width, y + 16 * dy + Height); 1274 ca.LineTo(x + 16 * dx + Width, y); 1275 end; 1268 for i := 0 to Length(Brightness) - 1 do begin // gradient 1269 r := Color and $FF + Brightness[i]; 1270 if r < 0 then 1271 r := 0 1272 else if r >= 256 then 1273 r := 255; 1274 g := Color shr 8 and $FF + Brightness[i]; 1275 if g < 0 then 1276 g := 0 1277 else if g >= 256 then 1278 g := 255; 1279 b := Color shr 16 and $FF + Brightness[i]; 1280 if b < 0 then 1281 b := 0 1282 else if b >= 256 then 1283 b := 255; 1284 ca.Pen.Color := r + g shl 8 + b shl 16; 1285 ca.MoveTo(x + dx * i, y + dy * i); 1286 ca.LineTo(x + dx * i + Width, y + dy * i + Height); 1287 end; 1288 ca.Pen.Color := $000000; 1289 ca.MoveTo(x + 1, y + 16 * dy + Height); 1290 ca.LineTo(x + 16 * dx + Width, y + 16 * dy + Height); 1291 ca.LineTo(x + 16 * dx + Width, y); 1276 1292 end; 1277 1293 … … 1549 1565 end; 1550 1566 1551 procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Integer);1567 procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Cardinal); 1552 1568 var 1553 1569 SrcPixel, DstPixel: TPixelPointer; … … 1645 1661 UniFont[section].Size := 1646 1662 Round(size * DpiScreen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8); 1663 //UniFont[section].Size := Round(Size * 72 / UniFont[section].PixelsPerInch); 1647 1664 end; 1648 1665 end; … … 1679 1696 LoadFonts; 1680 1697 LoadGraphicFile(Templates, GetGraphicsDir + DirectorySeparator + 1681 'Templates.png', gfNoGamma);1698 'Templates.png', [gfNoGamma]); 1682 1699 LoadGraphicFile(Colors, GetGraphicsDir + DirectorySeparator + 'Colors.png'); 1683 1700 LoadGraphicFile(Paper, GetGraphicsDir + DirectorySeparator + 'Paper.jpg'); -
branches/highdpi/Packages/CevoComponents/Sound.pas
r210 r303 5 5 uses 6 6 UDpiControls, SysUtils, Classes, Graphics, Controls, Forms, fgl, FileUtil, 7 StringTables, Directories 7 StringTables, Directories, LCLType 8 8 {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF} 9 {$IFDEF LINUX}, Process, AsyncProcess {$ENDIF};9 {$IFDEF LINUX}, Process, AsyncProcess2{$ENDIF}; 10 10 11 11 type … … 40 40 constructor Create(const FileName: string); 41 41 destructor Destroy; override; 42 procedure Play(H WND: DWORD);42 procedure Play(Handle: HWND); 43 43 procedure Stop; 44 44 procedure Reset; … … 68 68 {$R *.lfm} 69 69 70 {$IFDEF LINUX} 70 71 resourcestring 71 72 SUnableToPlay = 'PlayStyle=%s: Unable to play %s Message:%s'; 72 73 SPlayCommandNotWork = 'The play command %s does not work on your system'; 74 {$ENDIF} 73 75 74 76 constructor TSound.Create(const FileName: string); … … 113 115 begin 114 116 Result := ''; 117 // Try ffplay 118 if (Result = '') then 119 if (FindDefaultExecutablePath('ffplay') <> '') then 120 Result := 'ffplay -autoexit -nodisp -loglevel quiet'; 115 121 // Try play 116 if (FindDefaultExecutablePath('play') <> '') then 117 Result := 'play'; 122 if (Result = '') then 123 if (FindDefaultExecutablePath('play') <> '') then 124 Result := 'play -q'; 118 125 // Try aplay 119 if ( result = '') then126 if (Result = '') then 120 127 if (FindDefaultExecutablePath('aplay') <> '') then 121 128 Result := 'aplay -q'; … … 136 143 if (FindDefaultExecutablePath('pacat') <> '') then 137 144 Result := 'pacat -p'; 138 // Try ffplay139 if (Result = '') then140 if (FindDefaultExecutablePath('ffplay') <> '') then141 result := 'ffplay -autoexit -nodisp';142 145 // Try cvlc 143 146 if (Result = '') then 144 147 if (FindDefaultExecutablePath('cvlc') <> '') then 145 result := 'cvlc -q --play-and-exit';148 Result := 'cvlc -q --play-and-exit'; 146 149 // Try canberra-gtk-play 147 150 if (Result = '') then … … 155 158 156 159 157 procedure TSound.Play(H WND: DWORD);160 procedure TSound.Play(Handle: HWND); 158 161 {$IFDEF WINDOWS} 159 162 var … … 169 172 if FDeviceID <> 0 then 170 173 begin 171 PlayParm.dwCallback := H WND;174 PlayParm.dwCallback := Handle; 172 175 mciSendCommand(FDeviceID, MCI_PLAY, MCI_NOTIFY, DWORD_PTR(@PlayParm)); 173 176 end … … 217 220 end; 218 221 finally 219 L.Free;222 FreeAndNil(L); 220 223 end; 221 224 end -
branches/highdpi/Packages/CevoComponents/StringTables.pas
r210 r303 19 19 function GetHandle(const Item: string): integer; 20 20 function LookupByHandle(Handle: integer; Index: integer = -1): string; 21 function Lookup(const Item: string; Index: integer = -1): string;21 function Lookup(const Item: string; Index: Integer = -1): string; 22 22 function Search(const Content: string; var Handle, Index: integer): boolean; 23 23 end; 24 24 25 25 26 implementation … … 70 71 s: string; 71 72 begin 72 if Index < 0 then 73 if Index < 0 then begin 73 74 if Handle < 0 then begin 74 75 Result := ''; … … 86 87 end; 87 88 Result := S; 88 end else 89 if (Handle + Index + 1) >= Lines.Count then begin 90 Result := ''; 91 Exit; 92 end else Result := Lines[Handle + Index + 1]; 89 end; 90 end else 91 if (Handle + Index + 1) >= Lines.Count then begin 92 Result := ''; 93 Exit; 94 end else Result := Lines[Handle + Index + 1]; 93 95 while (Result <> '') and ((Result[1] = ' ') or (Result[1] = #9)) do 94 96 Delete(Result, 1, 1); … … 99 101 end; 100 102 101 function TStringTable.Lookup(const Item: string; Index: integer): string;103 function TStringTable.Lookup(const Item: string; Index: Integer): string; 102 104 var 103 Handle: integer;105 Handle: Integer; 104 106 begin 105 107 Handle := GetHandle(Item); 106 if Handle >= 0 then 107 result := LookupByHandle(Handle, Index) 108 else 109 result := ''; 110 if result = '' then 111 if Index < 0 then 112 result := Format('[%s]', [Item]) 113 else 114 result := Format('[%s %d]', [Item, Index]) 108 if Handle >= 0 then Result := LookupByHandle(Handle, Index) 109 else Result := ''; 110 if Result = '' then begin 111 if Index < 0 then Result := Format('[%s]', [Item]) 112 else Result := Format('[%s %d]', [Item, Index]); 113 end; 115 114 end; 116 115 … … 153 152 begin 154 153 result := false; 155 exit 154 exit; 156 155 end; 157 156 if Copy(Lines[h + i + 1], 1, 1) = '#' then 158 157 begin 159 158 h := h + i + 1; 160 i := -1 159 i := -1; 161 160 end; 162 161 if (h >= 0) and not ((Length(Lines[h + i + 1]) > 0) and (Lines[h + i + 1][1] in ['#', ':', ';'])) and -
branches/highdpi/Packages/DpiControls/UDpiControls.pas
r272 r303 47 47 public 48 48 property BorderStyle; 49 property OnKeyDown; 49 50 end; 50 51 … … 415 416 TDpiWinControl = class(TDpiControl) 416 417 private 418 FOnKeyDown: TKeyEvent; 417 419 function GetBorderStyle: TBorderStyle; 418 420 function GetHandle: HWND; … … 429 431 procedure SetTabOrder(AValue: TTabOrder); 430 432 procedure SetTabStop(AValue: Boolean); 433 procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState); 431 434 protected 435 procedure UpdateNativeControl; override; 432 436 function GetNativeControl: TControl; override; 433 437 function GetNativeWinControl: TWinControl; virtual; 434 438 property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone; 439 procedure KeyDown(var Key: Word; Shift: TShiftState); virtual; 435 440 public 436 441 Controls: TDpiControls; … … 443 448 property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1; 444 449 property TabStop: Boolean read GetTabStop write SetTabStop default False; 445 property OnKeyDown: TKeyEvent read GetOnKeyDown write SetOnKeyDown;450 property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; 446 451 property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress; 447 452 property OnKeyUp: TKeyEvent read GetOnKeyUp write SetOnKeyUp; … … 2911 2916 end; 2912 2917 2918 procedure TDpiWinControl.KeyDownHandler(Sender: TObject; var Key: Word; 2919 Shift: TShiftState); 2920 begin 2921 KeyDown(Key, Shift); 2922 if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift); 2923 end; 2924 2925 procedure TDpiWinControl.UpdateNativeControl; 2926 begin 2927 inherited; 2928 GetNativeWinControl.OnKeyDown := @KeyDownHandler; 2929 end; 2930 2913 2931 function TDpiWinControl.GetNativeControl: TControl; 2914 2932 begin … … 2919 2937 begin 2920 2938 Result := nil; 2939 end; 2940 2941 procedure TDpiWinControl.KeyDown(var Key: Word; Shift: TShiftState); 2942 begin 2921 2943 end; 2922 2944 -
branches/highdpi/Platform.pas
r210 r303 58 58 finalization 59 59 60 NowPreciseLock.Free;60 FreeAndNil(NowPreciseLock); 61 61 62 62 end. -
branches/highdpi/Settings.lfm
r302 r303 1 object LocaleDlg: TLocaleDlg1 object SettingsDlg: TSettingsDlg 2 2 Left = 766 3 3 Height = 448 -
branches/highdpi/Settings.pas
r302 r303 1 unit Locale;1 unit Settings; 2 2 3 3 {$mode delphi} … … 24 24 end; 25 25 26 { T LocaleDlg }26 { TSettingsDlg } 27 27 28 T LocaleDlg = class(TDrawDlg)28 TSettingsDlg = class(TDrawDlg) 29 29 ButtonFullscreen: TButtonC; 30 30 List: TDpiListBox; … … 42 42 public 43 43 Languages: TLanguages; 44 procedure LoadData; 45 procedure SaveData; 44 46 end; 45 47 46 48 var 47 LocaleDlg: TLocaleDlg;49 SettingsDlg: TSettingsDlg; 48 50 49 51 implementation … … 82 84 end; 83 85 84 { T LocaleDlg }86 { TSettingsDlg } 85 87 86 procedure T LocaleDlg.FormCreate(Sender: TObject);88 procedure TSettingsDlg.FormCreate(Sender: TObject); 87 89 begin 88 90 Canvas.Font.Assign(UniFont[ftNormal]); … … 105 107 106 108 ButtonFullscreen.Graphic := GrExt[HGrSystem].Data; 107 if FullScreen then ButtonFullscreen.ButtonIndex := 3108 else ButtonFullscreen.ButtonIndex := 2;109 109 end; 110 110 111 procedure T LocaleDlg.CancelBtnClick(Sender: TObject);111 procedure TSettingsDlg.CancelBtnClick(Sender: TObject); 112 112 begin 113 113 ModalResult := mrCancel; 114 114 end; 115 115 116 procedure T LocaleDlg.ButtonFullscreenClick(Sender: TObject);116 procedure TSettingsDlg.ButtonFullscreenClick(Sender: TObject); 117 117 begin 118 FullScreen := not FullScreen;119 118 ButtonFullscreen.ButtonIndex := ButtonFullscreen.ButtonIndex xor 1; 120 119 end; 121 120 122 procedure T LocaleDlg.FormDestroy(Sender: TObject);121 procedure TSettingsDlg.FormDestroy(Sender: TObject); 123 122 begin 124 123 FreeAndNil(Languages); 125 124 end; 126 125 127 procedure T LocaleDlg.FormPaint(Sender: TObject);126 procedure TSettingsDlg.FormPaint(Sender: TObject); 128 127 var 129 128 S: string; … … 148 147 end; 149 148 150 procedure T LocaleDlg.FormShow(Sender: TObject);149 procedure TSettingsDlg.FormShow(Sender: TObject); 151 150 begin 152 151 Languages.LoadToStrings(List.Items); 152 List.Font.Color := MainTexture.clMark; 153 LoadData; 154 end; 155 156 procedure TSettingsDlg.OKBtnClick(Sender: TObject); 157 begin 158 SaveData; 159 ModalResult := mrOk; 160 end; 161 162 procedure TSettingsDlg.LoadData; 163 begin 153 164 List.ItemIndex := Languages.Search(LocaleCode); 154 165 if (List.ItemIndex = -1) and (Languages.Count > 0) then 155 166 List.ItemIndex := 0; 156 List.Font.Color := MainTexture.clMark; 167 if FullScreen then ButtonFullscreen.ButtonIndex := 3 168 else ButtonFullscreen.ButtonIndex := 2; 157 169 end; 158 170 159 procedure T LocaleDlg.OKBtnClick(Sender: TObject);171 procedure TSettingsDlg.SaveData; 160 172 begin 161 173 LocaleCode := Languages[List.ItemIndex].ShortName; 162 ModalResult := mrOk;174 FullScreen := (ButtonFullscreen.ButtonIndex and 1) = 1; 163 175 end; 164 176 -
branches/highdpi/Start.pas
r248 r303 48 48 Bitmap: TDpiBitmap; { game world sample preview } 49 49 Size: TPoint; 50 Colors: array [0 .. $1f, 0 .. 1] of TColor;50 Colors: array [0 .. 11, 0 .. 1] of TColor; 51 51 Mode: TMiniMode; 52 52 procedure LoadFromLogFile(FileName: string; var LastTurn: Integer); … … 143 143 DefaultAI: string; 144 144 MiniMap: TMiniMap; 145 LastGame: string; 145 146 procedure DrawAction(y, IconIndex: integer; HeaderItem, TextItem: string); 146 147 procedure InitPopup(PlayerIndex: Integer); … … 165 166 166 167 uses 167 Global, Directories, Direct, ScreenTools, Inp, Back, Locale, UPixelPointer;168 Global, Directories, Direct, ScreenTools, Inp, Back, Settings, UPixelPointer; 168 169 169 170 {$R *.lfm} … … 241 242 begin 242 243 FreeAndNil(Bitmap); 243 inherited Destroy;244 inherited; 244 245 end; 245 246 … … 297 298 ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + '.png'; 298 299 Mode := mmPicture; 299 if LoadGraphicFile(Bitmap, ImageFileName, gfNoError) then300 if LoadGraphicFile(Bitmap, ImageFileName, [gfNoError]) then 300 301 begin 301 302 if Bitmap.width div 2 > MaxWidthMapLogo then … … 461 462 Brains.GetByKind(btAI, AIBrains); 462 463 BrainDefault := Brains[0]; 463 AIBrains.Free;464 FreeAndNil(AIBrains); 464 465 end; // default AI not found, use any 465 466 … … 536 537 FormerGames := TStringList.Create; 537 538 UpdateFormerGames; 538 ShowTab := tbNew; // always start with new book page539 539 MapFileName := ''; 540 540 Maps := TStringList.Create; … … 616 616 if ValueExists('AutoDiff') then AutoDiff := Reg.ReadInteger('AutoDiff') 617 617 else AutoDiff := 1; 618 if ValueExists('StartTab') then ShowTab := TStartTab(Reg.ReadInteger('StartTab')) 619 else ShowTab := tbNew; 620 if ValueExists('LastGame') then LastGame := Reg.ReadString('LastGame') 621 else LastGame := ''; 618 622 619 623 if ValueExists('ScreenMode') then … … 656 660 else WriteInteger('ScreenMode', 0); 657 661 WriteInteger('MultiControl', MultiControl); 662 WriteInteger('StartTab', Integer(ShowTab)); 663 WriteString('LastGame', LastGame); 658 664 finally 659 665 Free; … … 671 677 with AIBrains[I] do begin 672 678 if not LoadGraphicFile(AIBrains[i].Picture, GetAiDir + DirectorySeparator + 673 FileName + DirectorySeparator + FileName + '.png', gfNoError) then begin679 FileName + DirectorySeparator + FileName + '.png', [gfNoError]) then begin 674 680 with AIBrains[i].Picture.Canvas do begin 675 681 Brush.Color := $904830; … … 683 689 end; 684 690 end; 685 AIBrains.Free;691 FreeAndNil(AIBrains); 686 692 end; 687 693 … … 1396 1402 if AIBrains[I].Flags and fMultiple <> 0 then 1397 1403 OfferBrain(AIBrains[I], FixedLines); 1398 AIBrains.Free;1404 FreeAndNil(AIBrains); 1399 1405 end else begin 1400 1406 FixedLines := 0; … … 1424 1430 or (Brains[I] = PlayersBrain[PlayerPopupIndex]) then 1425 1431 OfferBrain(AIBrains[i], FixedLines); 1426 AIBrains.Free;1432 FreeAndNil(AIBrains); 1427 1433 end; 1428 1434 end; … … 1444 1450 until FindNext(F) <> 0; 1445 1451 FindClose(F); 1446 ListIndex[tbNew] := FormerGames.Count - 1;1447 if (ShowTab = tbNew) and (FormerGames.Count > 0) then1448 ShowTab := tbPrevious;1452 I := FormerGames.IndexOf(LastGame); 1453 if I >= 0 then ListIndex[tbPrevious] := I 1454 else ListIndex[tbPrevious] := FormerGames.Count - 1; 1449 1455 TurnValid := False; 1450 1456 end; … … 1608 1614 if Tab <> tbNew then 1609 1615 if List.Count > 0 then begin 1610 if (ListIndex[Tab] < List.Count) and (ListIndex[Tab] >= 0) then 1611 List.ItemIndex := ListIndex[Tab] 1612 1616 if (ListIndex[Tab] < List.Count) and (ListIndex[Tab] >= 0) then begin 1617 List.ItemIndex := ListIndex[Tab]; 1618 end else List.ItemIndex := 0; 1613 1619 end else List.ItemIndex := -1; 1614 1620 case Tab of … … 1650 1656 maConfig: 1651 1657 begin 1652 LocaleDlg := TLocaleDlg.Create(nil);1653 if LocaleDlg.ShowModal = mrOk then begin1658 SettingsDlg := TSettingsDlg.Create(nil); 1659 if SettingsDlg.ShowModal = mrOk then begin 1654 1660 LoadAssets; 1655 1661 Invalidate; … … 1657 1663 Background.UpdateInterface; 1658 1664 end; 1659 FreeAndNil( LocaleDlg);1665 FreeAndNil(SettingsDlg); 1660 1666 end; 1661 1667 maManual: … … 1953 1959 ShowTab := Tab; 1954 1960 Background.Enabled := True; 1961 LastGame := FormerGames[ListIndex[tbPrevious]]; 1955 1962 end; 1956 1963 … … 1963 1970 Shift: TShiftState); 1964 1971 begin 1965 if (Shift = []) and (Key = VK_F1)then1972 if KeyToShortCut(Key, Shift) = VK_F1 then 1966 1973 DirectHelp(cStartHelp); 1967 1974 end; -
branches/highdpi/UnitProcessing.pas
r210 r303 5 5 6 6 uses 7 Protocol, Database;7 SysUtils, Protocol, Database; 8 8 9 9 type … … 1035 1035 end 1036 1036 end; 1037 Q.Free;1037 FreeAndNil(Q); 1038 1038 if (Loc = a.ToLoc) or (a.ToLoc = maNextCity) and (Loc >= 0) and 1039 1039 (Map[Loc] and fCity <> 0) then … … 1165 1165 end 1166 1166 end; 1167 Q.Free;1167 FreeAndNil(Q); 1168 1168 end; // CanPlaneReturn 1169 1169 -
branches/highdpi/readme.txt
r210 r303 1 C-evo 1.2.0 sources ported to Lazarus/FPC 1 C-evo 1.3.0 Horizons 2 ======================== 2 3 3 * Used development environment: Lazarus 2.0.8(https://www.lazarus-ide.org/)4 * Developed with: Lazarus 2.0.12 (https://www.lazarus-ide.org/) 4 5 * Supported platforms: Windows and Linux 5 6 * Supported architectures: 32-bit and 64-bit x86 6 7 7 = Code changes to original source=8 = Code changes to original source = 8 9 9 10 * Converted from Delphi to Lazarus … … 18 19 * Design time components converted to Lazarus package (cevocomponenets.lpk) 19 20 20 =Original readme content= 21 = Development = 22 23 * Home page: https://app.zdechov.net/c-evo/ 24 * Source code: https://svn.zdechov.net/c-evo/ 25 * Developed in [http://www.lazarus-ide.org/ Lazarus/FPC] 2.0.12 26 * To build new Windows installer run Install/build.bat. InnoSetup (http://www.jrsoftware.org/isdl.php) needs to be installed). 27 28 == Release new version == 29 30 * Update version in GameServer.pas Version constant. 31 * Update version in Install\win\Common.iss MyAppVersion define. 32 * Update version in Install\rpm\c-evo.spec Version field. 33 * Update version in Install\deb\control Standards-Version field. 34 * Build all binary installer packages and put them into bin directory. 35 36 = Original readme content = 21 37 22 38 The C-evo sources
Note:
See TracChangeset
for help on using the changeset viewer.