source: branches/delphi/AI/AI.pas

Last change on this file was 22, checked in by chronos, 7 years ago
  • Added: Delphi AI development kit.
File size: 21.4 KB
Line 
1{$INCLUDE switches.inc}
2unit AI;
3
4interface
5
6uses
7{$IFDEF DEBUG}SysUtils, {$ENDIF} // necessary for debug exceptions
8 Protocol, CustomAI, ToolAI;
9
10type
11 UnitRole = (Roam, Defend);
12
13 TAI = class(TToolAI)
14 constructor Create(Nation: integer); override;
15
16 protected
17 procedure DoTurn; override;
18 procedure DoNegotiation; override;
19 function ChooseResearchAdvance: integer; override;
20 function ChooseGovernment: integer; override;
21 function WantNegotiation(Nation: integer; NegoTime: TNegoTime)
22 : boolean; override;
23
24 procedure ProcessSettlers;
25 procedure ProcessUnit(uix: integer; Role: UnitRole);
26 procedure SetCityProduction;
27 end;
28
29implementation
30
31uses
32 Pile;
33
34const
35 // fine adjustment
36 Aggressive = 40; // 0 = never attacks, 100 = attacks even with heavy losses
37 DestroyBonus = 30; // percent of building cost
38
39constructor TAI.Create(Nation: integer);
40begin
41 inherited;
42end;
43
44
45// -------------------------------
46// MY TURN
47// -------------------------------
48
49procedure TAI.DoTurn;
50var
51 uix: integer;
52begin
53 // correct tax rate if necessary
54 if RO.Money > RO.nCity * 16 then
55 ChangeRates(RO.TaxRate - 10, 0)
56 else if RO.Money < RO.nCity * 8 then
57 ChangeRates(RO.TaxRate + 10, 0);
58
59 // better government form available?
60 if RO.Government <> gAnarchy then
61 if IsResearched(adTheRepublic) then
62 begin
63 if RO.Government <> gRepublic then
64 Revolution
65 end
66 else if IsResearched(adMonarchy) then
67 begin
68 if RO.Government <> gMonarchy then
69 Revolution
70 end;
71
72 // do combat
73 for uix := 0 to RO.nUn - 1 do
74 if (MyUnit[uix].Loc >= 0) and not(MyModel[MyUnit[uix].mix].Kind
75 in [mkSettler, mkSlaves]) then
76 ProcessUnit(uix, Roam);
77
78 ProcessSettlers;
79
80 // do discover/patrol
81
82 OptimizeCityTiles;
83 SetCityProduction;
84end;
85
86// ProcessSettlers: move settlers, do terrain improvement, found cities
87procedure TAI.ProcessSettlers;
88var
89 uix, cix, ecix, Loc, RadiusLoc, TestScore, BestNearCityScore, TerrType,
90 Special, V21: integer;
91 Radius: TVicinity21Loc;
92 ResourceScore, CityScore: array [0 .. lxmax * lymax - 1] of integer;
93
94 procedure ReserveCityRadius(Loc: integer);
95 var
96 V21, RadiusLoc: integer;
97 Radius: TVicinity21Loc;
98 begin
99 V21_to_Loc(Loc, Radius);
100 for V21 := 1 to 26 do
101 begin
102 RadiusLoc := Radius[V21];
103 if (RadiusLoc >= 0) and (RadiusLoc < MapSize) then
104 ResourceScore[RadiusLoc] := 0
105 end
106 end;
107
108begin
109 JobAssignment_Initialize;
110
111 // rate resources of all tiles
112 fillchar(ResourceScore, MapSize * sizeof(integer), 0);
113 for Loc := 0 to MapSize - 1 do
114 if (Map[Loc] and fRare) = 0 then
115 if (Map[Loc] and fTerrain) = fGrass then
116 if (Map[Loc] and fSpecial) <> 0 then
117 ResourceScore[Loc] := 3 // plains, 3 points
118 else
119 ResourceScore[Loc] := 2 // grassland, 2 points
120 else if (Map[Loc] and fSpecial) <> 0 then
121 ResourceScore[Loc] := 4; // special resource, 4 points
122 for cix := 0 to RO.nCity - 1 do
123 if MyCity[cix].Loc >= 0 then
124 ReserveCityRadius(MyCity[cix].Loc); // these resources already have a city
125 for uix := 0 to RO.nUn - 1 do
126 if (MyUnit[uix].Loc >= 0) and (MyUnit[uix].Job = jCity) then
127 ReserveCityRadius(MyUnit[uix].Loc);
128 // these resources almost already have a city
129 for ecix := 0 to RO.nEnemyCity - 1 do
130 if RO.EnemyCity[ecix].Loc >= 0 then
131 ReserveCityRadius(RO.EnemyCity[ecix].Loc);
132 // these resources already have an enemy city
133
134 // rate possible new cities
135 fillchar(CityScore, MapSize * sizeof(integer), 0);
136 for Loc := 0 to MapSize - 1 do
137 if ((Map[Loc] and fTerrain) = fGrass) and ((Map[Loc] and fRare) = 0) and
138 ((RO.Territory[Loc] < 0) or (RO.Territory[Loc] = me)) then
139 // don't consider founding cities in foreign nation territory
140 begin
141 TestScore := 0;
142 BestNearCityScore := 0;
143 V21_to_Loc(Loc, Radius);
144 for V21 := 1 to 26 do
145 begin // sum resource scores in potential city radius
146 RadiusLoc := Radius[V21];
147 if (RadiusLoc >= 0) and (RadiusLoc < MapSize) then
148 begin
149 TestScore := TestScore + ResourceScore[RadiusLoc];
150 if CityScore[RadiusLoc] > BestNearCityScore then
151 BestNearCityScore := CityScore[RadiusLoc]
152 end
153 end;
154 if TestScore >= 10 then // city is worth founding
155 begin
156 TestScore := TestScore shl 8 + ((Loc xor me) * 4567) mod 251;
157 // some unexactness, random but always the same for this tile
158 if TestScore > BestNearCityScore then
159 begin // better than all other sites in radius
160 if BestNearCityScore > 0 then // found no other cities in radius
161 begin
162 for V21 := 1 to 26 do
163 begin
164 RadiusLoc := Radius[V21];
165 if (RadiusLoc >= 0) and (RadiusLoc < MapSize) then
166 CityScore[RadiusLoc] := 0;
167 end;
168 end;
169 CityScore[Loc] := TestScore
170 end;
171 end
172 end;
173 for Loc := 0 to MapSize - 1 do
174 if CityScore[Loc] > 0 then
175 JobAssignment_AddJob(Loc, jCity, 10);
176
177 // improve terrain
178 for cix := 0 to RO.nCity - 1 do
179 with MyCity[cix] do
180 if Loc >= 0 then
181 begin
182 V21_to_Loc(Loc, Radius);
183 for V21 := 1 to 26 do
184 if (Tiles and (1 shl V21) and not(1 shl CityOwnTile)) <> 0 then
185 begin // tile is exploited, but not the city own tile -- check if improvable
186 RadiusLoc := Radius[V21];
187 assert((RadiusLoc >= 0) and (RadiusLoc < MapSize));
188 if (RadiusLoc >= 0) and (RadiusLoc < MapSize) then
189 begin
190 TerrType := Map[RadiusLoc] and fTerrain;
191 Special := Map[RadiusLoc] shr 5 and 3;
192 if TerrType >= fGrass then // can't improve water tiles
193 if (Terrain[TerrType].IrrEff > 0) // terrain is irrigatable
194 and not((RO.Government = gDespotism) and
195 (Terrain[TerrType].FoodRes[Special] >= 3))
196 // improvement makes no sense when limit is depotism
197 and ((Map[RadiusLoc] and fTerImp) = 0) then
198 // no terrain improvement yet
199 JobAssignment_AddJob(RadiusLoc, jIrr, 50) // irrigate!
200 else if (Terrain[TerrType].MoveCost = 1) // plain terrain
201 and ((Map[RadiusLoc] and (fRoad or fRR or fRiver)) = 0) then
202 // no road or railroad yet, no river
203 JobAssignment_AddJob(RadiusLoc, jRoad, 40);
204 // build road (The Wheel trade benefit)
205 end
206 end;
207 end;
208
209 // choose all settlers to work
210 for uix := 0 to RO.nUn - 1 do
211 if (MyUnit[uix].Loc >= 0) and
212 (MyModel[MyUnit[uix].mix].Kind in [mkSettler, mkSlaves]) then
213 JobAssignment_AddUnit(uix);
214
215 JobAssignment_Go;
216end; // ProcessSettlers
217
218// ProcessUnit: execute attack, capture, discover or patrol task according to unit role
219procedure TAI.ProcessUnit(uix: integer; Role: UnitRole);
220const
221 DistanceScore = 4;
222var
223 BestScore, BestCount, BestLoc, TerrType, TestLoc, NextLoc, TestDistance, Tile,
224 V8, TestScore, euix, MyDamage, EnemyDamage, TerrOwner, StepSize, OldLoc,
225 AttackForecast, MoveResult, AttackResult: integer;
226 Exhausted: boolean;
227 TestTask, BestTask: (utNone, utAttack, utCapture, utDiscover, utPatrol,
228 utGoHome);
229 Adjacent: TVicinity8Loc;
230 AdjacentUnknown: array [0 .. lxmax * lymax - 1] of integer;
231
232begin
233 Pile.Create(MapSize);
234 with MyUnit[uix] do
235 repeat
236 BestScore := -999999;
237 BestTask := utNone;
238 fillchar(AdjacentUnknown, sizeof(AdjacentUnknown), $FF);
239 // -1, indicates tiles not checked yet
240 Pile.Empty;
241 Pile.Put(Loc, 0); // start search for something to do at current location
242 while Pile.Get(TestLoc, TestDistance) do
243 begin
244 TestScore := 0;
245 Tile := Map[TestLoc];
246 AdjacentUnknown[TestLoc] := 0;
247
248 if ((Tile and fUnit) <> 0) and ((Tile and fOwned) = 0) then
249 begin // enemy unit
250 Unit_FindEnemyDefender(TestLoc, euix);
251 if RO.Treaty[RO.EnemyUn[euix].Owner] < trPeace then
252 begin // unfriendly unit -- check attack
253 if Unit_AttackForecast(uix, TestLoc, 100, AttackForecast) then
254 begin // attack possible, but advantageous?
255 if AttackForecast > 0 then
256 begin // enemy unit would be destroyed
257 MyDamage := Health - AttackForecast;
258 EnemyDamage := RO.EnemyUn[euix].Health + DestroyBonus;
259 end
260 else // own unit would be destroyed
261 begin
262 MyDamage := Health + DestroyBonus;
263 EnemyDamage := RO.EnemyUn[euix].Health + AttackForecast;
264 end;
265 TestScore := Aggressive * 2 *
266 (EnemyDamage * RO.EnemyModel[RO.EnemyUn[euix].emix].Cost)
267 div (MyDamage * MyModel[mix].Cost);
268 if TestScore <= 100 then
269 TestScore := 0 // own losses exceed enemy losses, no good
270 else
271 begin
272 TestScore := (TestScore - 100) div 10 + 30;
273 TestTask := utAttack
274 end
275 end
276 end
277 end // enemy unit
278
279 else if ((Tile and fCity) <> 0) and ((Tile and fOwned) = 0) then
280 begin // enemy city, empty or unobserved
281 if (MyModel[mix].Domain = dGround)
282 // ships of this AI have no long-range guns, so don't try to attack cities with them
283 and ((RO.Territory[TestLoc] < 0)
284 // happens only for unobserved cities of extinct tribes, new owner unknown
285 or (RO.Treaty[RO.Territory[TestLoc]] < trPeace)) then
286 begin // unfriendly city -- check attack/capture
287 if (Tile and fObserved) <> 0 then
288 begin // observed and no unit present -- city is undefended, capture!
289 TestScore := 40;
290 TestTask := utCapture
291 end
292 else if Role = Roam then
293 begin // unobserved city, possibly defended -- go for attack
294 TestScore := 30;
295 TestTask := utPatrol
296 end
297 end
298 end // enemy city, empty or unobserved
299
300 else
301 begin // no enemy city or unit here
302 // add surrounding tiles to queue, but only if there's a chance to beat BestScore
303 if 50 - DistanceScore * (TestDistance + 1) >= BestScore then
304 // assume a score of 50 is the best achievable
305 begin
306 V8_to_Loc(TestLoc, Adjacent);
307 for V8 := 0 to 7 do
308 begin
309 NextLoc := Adjacent[V8];
310 if (NextLoc >= 0) and (NextLoc < MapSize) and
311 (AdjacentUnknown[NextLoc] < 0) then // tile not checked yet
312 begin
313 TerrType := Map[NextLoc] and fTerrain;
314 if TerrType = fUNKNOWN then
315 inc(AdjacentUnknown[TestLoc])
316 else
317 begin
318 case MyModel[mix].Domain of
319 dGround:
320 begin
321 TerrOwner := RO.Territory[NextLoc];
322 if (TerrType >= fGrass) and (TerrType <> fArctic)
323 // terrain can be walked
324 and ((TerrOwner < 0) or (TerrOwner = me) or
325 (RO.Treaty[TerrOwner] < trPeace))
326 // no peace treaty violated
327 and (((Map[NextLoc] and (fUnit or fCity)) <> 0) or
328 (Map[TestLoc] and Map[NextLoc] and fInEnemyZoC = 0))
329 then // no ZoC violated
330 begin // yes, consider walking this tile
331 if TerrType = fMountains then
332 StepSize := 2 // mountains cause delay
333 else
334 StepSize := 1
335 end
336 else
337 StepSize := 0 // no, don't walk here
338 end;
339 dSea:
340 if TerrType = fShore then
341 // ships of this AI can only move along shore
342 StepSize := 1
343 else
344 StepSize := 0;
345 dAir:
346 StepSize := 1;
347 end;
348 if StepSize > 0 then
349 Pile.Put(NextLoc, TestDistance + StepSize)
350 end
351 end;
352 end;
353 end;
354 if Role = Defend then
355 TestScore := 0 // don't discover/patrol
356 else if AdjacentUnknown[TestLoc] > 0 then
357 begin
358 TestScore := 20 + AdjacentUnknown[TestLoc];
359 TestTask := utDiscover
360 end
361 else
362 begin
363 TestScore := (RO.Turn - RO.MapObservedLast[TestLoc]) div 10;
364 TestTask := utPatrol
365 end
366 end; // no enemy city or unit here
367
368 if TestScore > 0 then
369 begin
370 TestScore := TestScore - DistanceScore * TestDistance;
371 if TestScore > BestScore then
372 BestCount := 0;
373 if TestScore >= BestScore then
374 begin
375 inc(BestCount);
376 if random(BestCount) = 0 then
377 begin
378 BestScore := TestScore;
379 BestLoc := TestLoc;
380 BestTask := TestTask;
381 end
382 end;
383 end
384 end;
385
386 if (BestTask = utNone) and ((Map[Loc] and fCity) = 0) then
387 begin // nothing to do, move home
388 if Home >= 0 then
389 BestLoc := MyCity[Home].Loc
390 else
391 BestLoc := maNextCity;
392 BestTask := utGoHome;
393 end;
394 if BestTask <> utNone then
395 begin // attack/capture/discover/patrol task found, execute it
396 OldLoc := Loc;
397 MoveResult := Unit_Move(uix, BestLoc);
398 Exhausted := (Loc = OldLoc) or
399 ((MoveResult and (rMoreTurns or rUnitRemoved)) <> 0);
400 if (BestTask = utAttack) and ((MoveResult and rLocationReached) <> 0)
401 then
402 if Movement < 100 then
403 Exhausted := true
404 else
405 begin
406 AttackResult := Unit_Attack(uix, BestLoc);
407 Exhausted := ((AttackResult and rExecuted) = 0) or
408 ((AttackResult and rUnitRemoved) <> 0);
409 end;
410 if not Exhausted then
411 Exhausted := (Movement < 100) and
412 ((Map[Loc] and (fRoad or fRR or fRiver or fCity)) = 0);
413 // no road, too few movement points for further movement
414 end
415 else
416 Exhausted := true;
417 until Exhausted;
418 Pile.Free;
419end; // ProcessUnit
420
421// SetCityProduction: choose production of each city
422procedure TAI.SetCityProduction;
423var
424 cix, mix, mixSettler, mixShip, mixArmy, V8, NewImprovement, count, wix,
425 AdjacentLoc: integer;
426 IsPort: boolean;
427 Adjacent: TVicinity8Loc;
428 Report: TCityReport;
429
430 procedure TryBuild(Improvement: integer);
431 begin
432 if (NewImprovement < 0) // already improvement of higher priority found
433 and (MyCity[cix].Built[Improvement] = 0) // not built yet
434 and City_Improvable(cix, Improvement) then
435 NewImprovement := Improvement;
436 end;
437
438begin
439 // only produce newest models
440 mixSettler := -1;
441 mixArmy := -1;
442 mixShip := -1;
443 for mix := 0 to RO.nModel - 1 do
444 with MyModel[mix] do
445 if Kind = mkSettler then
446 mixSettler := mix
447 else if (Domain = dGround) and (Kind < mkSpecial_TownGuard) then
448 mixArmy := mix
449 else if Domain = dSea then
450 mixShip := mix;
451
452 for cix := 0 to RO.nCity - 1 do
453 with MyCity[cix] do
454 if (RO.Turn = 0) or ((Flags and chProduction) <> 0)
455 // city production complete
456 or not City_HasProject(cix) then
457 begin // check production
458 IsPort := false;
459 V8_to_Loc(Loc, Adjacent);
460 for V8 := 0 to 7 do
461 begin
462 AdjacentLoc := Adjacent[V8];
463 if (AdjacentLoc >= 0) and (AdjacentLoc < MapSize) and
464 ((Map[AdjacentLoc] and fTerrain) = fShore) then
465 IsPort := true; // shore tile at adjacent location -- city is port!
466 end;
467 City_GetReport(cix, Report);
468
469 if (Report.Support = 0) or (SupportFree[RO.Government] < 2) and
470 (Report.Support < Report.ProdRep div 2) then
471 begin // enough material to support more units
472 if (RO.Turn > 4) and
473 ((Report.Eaten - Size * 2) div SettlerFood[RO.Government] <
474 Size div 4) then
475 // less than 1 settler per 4 citizens -- produce more!
476 City_StartUnitProduction(cix, mixSettler)
477 else if IsPort and (mixShip >= 0) and (random(2) = 0) then
478 City_StartUnitProduction(cix, mixShip)
479 else
480 City_StartUnitProduction(cix, mixArmy)
481 end
482 else
483 begin // check for building a city improvement
484 NewImprovement := -1;
485 if Built[imPalace] + Built[imCourt] + Built[imTownHall] = 0 then
486 begin
487 TryBuild(imCourt);
488 TryBuild(imTownHall);
489 end;
490 if Report.Trade - Report.Corruption >= 11 then
491 TryBuild(imLibrary);
492 if Report.Trade - Report.Corruption >= 11 then
493 TryBuild(imMarket);
494 if Size >= 9 then
495 TryBuild(imHighways);
496 if (RO.Government <> gDespotism) and (Size >= 4) then
497 TryBuild(imTemple);
498 if (RO.Government <> gDespotism) and (Size >= 6) then
499 TryBuild(imTheater);
500 if (RO.Government <> gDespotism) and (Size >= 8) then
501 TryBuild(imAqueduct);
502 if (Report.ProdRep >= 4) or (RO.nCity = 1) then
503 TryBuild(imBarracks);
504 TryBuild(imWalls);
505 if IsPort then
506 TryBuild(imCoastalFort);
507 if NewImprovement < 0 then
508 begin // nothing to produce -- check for building a wonder
509 count := 0;
510 for wix := 0 to nImp - 1 do
511 if (Imp[wix].Kind = ikWonder) and (RO.Wonder[wix].CityID = -1)
512 // not built yet
513 and ((Report.ProdRep - Report.Support) * 40 >= Imp[wix].Cost)
514 // takes less than 40 turns to produce
515 and City_Improvable(cix, wix) then
516 begin
517 inc(count);
518 if random(count) = 0 then
519 NewImprovement := wix // yes, build this wonder!
520 end;
521 end;
522 if NewImprovement >= 0 then
523 City_StartImprovement(cix, NewImprovement)
524 else if City_HasProject(cix) then
525 City_StopProduction(cix); // nothing to produce
526 end
527 end // check production
528end; // SetCityProduction
529
530function TAI.ChooseResearchAdvance: integer;
531var
532 mix: integer;
533begin
534 if not IsResearched(adWheel) then
535 begin
536 result := adWheel;
537 exit
538 end // research the wheel first
539 else if not IsResearched(adWarriorCode) then
540 begin
541 result := adWarriorCode;
542 exit
543 end // research warrior code first
544 else if not IsResearched(adHorsebackRiding) then
545 begin
546 result := adHorsebackRiding;
547 exit
548 end; // research horseback riding first
549
550 result := -1; // random advance
551 if random(10) = 0 then
552 begin // check military research
553 result := adMilitary;
554 if IsResearched(adMapMaking) and (random(2) = 0) then
555 begin // try to develop new ship
556 PrepareNewModel(dSea);
557 SetNewModelFeature(mcDefense, 3);
558 SetNewModelFeature(mcOffense, RO.DevModel.MaxWeight - 3);
559 end
560 else
561 begin // try to develop new ground unit
562 PrepareNewModel(dGround);
563 SetNewModelFeature(mcDefense, 1);
564 SetNewModelFeature(mcOffense, RO.DevModel.MaxWeight - 4);
565 SetNewModelFeature(mcMob, 2);
566 end;
567
568 // don't develop model twice
569 for mix := 0 to RO.nModel - 1 do
570 if (RO.DevModel.Domain = MyModel[mix].Domain) and
571 (RO.DevModel.Attack = MyModel[mix].Attack) and
572 (RO.DevModel.Defense = MyModel[mix].Defense) then
573 result := -1; // already have this model
574 end;
575end; // ChooseResearchAdvance
576
577function TAI.ChooseGovernment: integer;
578begin
579 if IsResearched(adTheRepublic) then
580 result := gRepublic
581 else if IsResearched(adMonarchy) then
582 result := gMonarchy
583 else
584 result := gDespotism
585end;
586
587
588// -------------------------------
589// DIPLOMACY
590// -------------------------------
591
592function TAI.WantNegotiation(Nation: integer; NegoTime: TNegoTime): boolean;
593begin
594 result := (NegoTime = EnemyCalled) // always accept contact
595 or (NegoTime = EndOfTurn) and (RO.Turn mod 20 = Nation + me)
596 // ask for contact only once in 20 turns
597end;
598
599procedure TAI.DoNegotiation;
600begin
601 if (RO.Treaty[Opponent] < trPeace) and Odd(me + Opponent) then
602 // make peace with some random nations
603 if (OppoAction = scDipOffer) and (OppoOffer.nCost = 0) and
604 (OppoOffer.nDeliver = 1) and (OppoOffer.Price[0] = opTreaty + trPeace)
605 then
606 MyAction := scDipAccept // accept peace
607 else if OppoAction = scDipStart then
608 begin
609 MyOffer.nCost := 0;
610 MyOffer.nDeliver := 1;
611 MyOffer.Price[0] := opTreaty + trPeace;
612 // offer peace in exchange of nothing
613 MyAction := scDipOffer;
614 end
615end;
616
617end.
Note: See TracBrowser for help on using the repository browser.