source: trunk/AI/StdAI/ToolAI.pas@ 486

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