source: trunk/AI/StdAI/ToolAI.pas

Last change on this file was 548, checked in by chronos, 3 weeks ago
  • Fixed: Bad unit drawing in battle dialog.
  • Modified: Code cleanup.
File size: 53.5 KB
Line 
1{$INCLUDE Switches.inc}
2unit ToolAI;
3
4interface
5
6uses
7 SysUtils, Math,
8{$IFDEF DEBUG}Names,{$ENDIF}
9 Protocol, CustomAI;
10
11type
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;
23 // tile that is in the middle of all own cities
24
25 function CityTaxBalance(cix: Integer; const CityReport: TCityReport): Integer;
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
31 procedure SumCities(TaxRate: Integer; var TaxSum, ScienceSum: Integer);
32 // calculates exact total tax and science income
33 // tax is reduced by maintenance (so might be negative)
34 // luxury not supported
35
36 procedure OptimizeCityTiles;
37 // obsolete; use City_OptimizeTiles instead
38
39 procedure GetCityProdPotential;
40 // calculates potential collected production resources of a city
41 // result: list for all cities in CityResult
42 procedure GetCityTradePotential;
43 // calculates potential collected trade resources of a city
44 // result: list for all cities in CityResult
45
46 procedure JobAssignment_Initialize;
47 // initialization, must be called first of the JobAssignment functions
48 procedure JobAssignment_AddJob(Loc, Job, Score: Integer);
49 // add job for settlers with certain score
50 // jobs include founding cities!
51 procedure JobAssignment_AddUnit(uix: Integer);
52 // add a settler unit to do jobs
53 procedure JobAssignment_Go;
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
59 function JobAssignment_GotJob(uix: Integer): Boolean;
60 // can be called after JobAssignment_Go to find out whether
61 // a certain settler has been assigned a job to
62
63 procedure AnalyzeMap;
64 // calculates formations and districts
65
66 function CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: Integer;
67 var TimeAfterStep, RecoverTurns: Integer; FromTile, ToTile: Integer;
68 IsCapture: Boolean): Integer;
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
72 // recover from damage taken in this move (rounded up)
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
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;
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
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;
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
102 // subsequent calls to MakeGroupPlan result in plans that may be executed parallel
103 // function returns false if no more transports are possible
104
105 function CurrentMStrength(Domain: Integer): Integer;
106 end;
107
108const
109 // no-formations
110 nfUndiscovered = -1;
111 nfPole = -2;
112 nfPeace = -3;
113
114 // return codes of CheckStep
115 csOk = 0;
116 // step is valid
117 // TimeAfterMove has been calculated
118 csForbiddenTile = 1;
119 // unit can not move onto this tile
120 // TimeAfterMove not calculated
121 csForbiddenStep = 2;
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
125 csCheckTerritory = 3;
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
130 // Unit_MoveEx
131 mxAdjacent = $00000001;
132
133var
134 nContinent, nOcean, nDistrict: Integer;
135 Formation: array[0..lxmax * lymax - 1] of Integer;
136 // water: ocean index, land: continent index, sorted by size
137 // territory unpassable due to peace treaty divides a continent
138 District: array[0..lxmax * lymax - 1] of Integer;
139 // index of coherent own territory, sorted by size
140 CityResult: array[0..nCmax - 1] of Integer;
141
142 Advancedness: array[0..nAdv - 1] of Integer;
143// total number of prerequisites for each advance
144
145implementation
146
147uses
148 Pile;
149
150type
151 pinteger = ^Integer;
152
153var
154 // for JobAssignment
155 MaxScore: Integer;
156 TileJob, TileJobScore: array[0..lxmax * lymax - 1] of Byte;
157 JobLocOfSettler: array[0..nUmax - 1] of Integer; // ToAssign = find job
158
159 // for Transport
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;
164
165procedure ReplaceD(Start, Stop: pinteger; Raider, Twix: Integer);
166begin
167 while Start <> Stop do
168 begin
169 if Start^ = Raider then
170 Start^ := Twix;
171 Inc(Start);
172 end;
173end;
174
175function NextZero(Start, Stop: pinteger; Mask: Cardinal): pinteger;
176begin
177 while (Start <> Stop) and (Start^ and Mask <> 0) do
178 Inc(Start);
179 Result := Start;
180end;
181
182function TToolAI.CenterOfEmpire: Integer;
183var
184 cix, Loc, X, Y, sy, N: Integer;
185 A, su, sv: Double;
186begin
187 N := 0;
188 sy := 0;
189 su := 0;
190 sv := 0;
191 for cix := 0 to RO.nCity - 1 do
192 begin
193 Loc := MyCity[cix].Loc;
194 if Loc >= 0 then
195 begin
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);
203 end;
204 end;
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;
212end;
213
214function TToolAI.CityTaxBalance(cix: Integer; const CityReport: TCityReport): Integer;
215var
216 I: Integer;
217begin
218 Result := 0;
219 if (CityReport.Working - CityReport.Happy <= MyCity[cix].Size shr 1) {no disorder} and
220 (MyCity[cix].Flags and chCaptured = 0) then // not captured
221 begin
222 Inc(Result, CityReport.Tax);
223 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) and
224 (CityReport.ProdRep > CityReport.Support) then
225 Inc(Result, CityReport.ProdRep - CityReport.Support);
226 if ((RO.Government = gLybertarianism) or (MyCity[cix].Size >=
227 NeedAqueductSize) and (CityReport.FoodRep < CityReport.Eaten + 2)) and
228 (CityReport.FoodRep > CityReport.Eaten) then
229 Inc(Result, CityReport.FoodRep - CityReport.Eaten);
230 end;
231 for I := nWonder to nImp - 1 do
232 if MyCity[cix].Built[I] > 0 then
233 Dec(Result, Imp[I].Maint);
234end;
235
236procedure TToolAI.SumCities(TaxRate: Integer; var TaxSum, ScienceSum: Integer);
237var
238 cix, p1: Integer;
239 CityReport: TCityReport;
240begin
241 TaxSum := 0;
242 ScienceSum := 0;
243 if RO.Government = gAnarchy then
244 Exit;
245 for p1 := 0 to nPl - 1 do
246 if RO.Tribute[p1] <= RO.TributePaid[p1] then
247 // don't rely on tribute from bankrupt nations
248 TaxSum := TaxSum + RO.Tribute[p1];
249 for cix := 0 to RO.nCity - 1 do
250 if MyCity[cix].Loc >= 0 then
251 begin
252 City_GetHypoReport(cix, -1, TaxRate, 0, CityReport);
253 if (CityReport.Working - CityReport.Happy <= MyCity[cix].Size shr
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;
258end;
259
260//------------------------------------------------------------------------------
261// City Tiles Processing
262
263const
264 pctOptimize = 0;
265 pctGetProdPotential = 1;
266 pctGetTradePotential = 2;
267
268procedure TToolAI.OptimizeCityTiles;
269var
270 cix: Integer;
271begin
272 for cix := 0 to RO.nCity - 1 do
273 with MyCity[cix] do
274 if Loc >= 0 then
275 City_OptimizeTiles(cix);
276end;
277
278procedure TToolAI.GetCityProdPotential;
279var
280 cix: Integer;
281 Advice: TCityTileAdviceData;
282begin
283 for cix := 0 to RO.nCity - 1 do
284 with MyCity[cix] do
285 if Loc >= 0 then
286 begin
287 Advice.ResourceWeights := rwMaxProd;
288 Server(sGetCityTileAdvice, Me, cix, Advice);
289 CityResult[cix] := Advice.CityReport.ProdRep; // considers factory, but shouldn't
290 end;
291end;
292
293procedure TToolAI.GetCityTradePotential;
294var
295 cix: Integer;
296 Advice: TCityTileAdviceData;
297begin
298 for cix := 0 to RO.nCity - 1 do
299 with MyCity[cix] do
300 if Loc >= 0 then
301 begin
302 Advice.ResourceWeights := rwMaxScience;
303 Server(sGetCityTileAdvice, Me, cix, Advice);
304 CityResult[cix] := Advice.CityReport.Trade;
305 end;
306end;
307
308//------------------------------------------------------------------------------
309// JobAssignment
310
311const
312 ToAssign = lxmax * lymax;
313
314procedure TToolAI.JobAssignment_Initialize;
315begin
316 FillChar(JobLocOfSettler, RO.nUn * SizeOf(Integer), $FF); // -1
317 FillChar(TileJob, MapSize, jNone);
318 FillChar(TileJobScore, MapSize, 0);
319 MaxScore := 0;
320end;
321
322procedure TToolAI.JobAssignment_AddJob(Loc, Job, Score: Integer);
323begin
324 if Score > 255 then
325 Score := 255;
326 if Score > TileJobScore[Loc] then
327 begin
328 TileJob[Loc] := Job;
329 TileJobScore[Loc] := Score;
330 if Score > MaxScore then
331 MaxScore := Score;
332 end;
333end;
334
335procedure TToolAI.JobAssignment_AddUnit(uix: Integer);
336begin
337 Assert(MyModel[MyUnit[uix].mix].Kind in [mkSettler, mkSlaves]);
338 JobLocOfSettler[uix] := ToAssign;
339end;
340
341function TToolAI.JobAssignment_GotJob(uix: Integer): Boolean;
342begin
343 Result := JobLocOfSettler[uix] >= 0;
344end;
345
346procedure TToolAI.JobAssignment_Go;
347const
348 DistanceScore = 4;
349 StepSizeByTerrain: array[0..11] of Integer =
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
352var
353 uix, BestScore, BestCount, BestLoc, BestJob, BestDistance, TestLoc,
354 NextLoc, TestDistance, V8, TestScore, StepSize, MoveResult: Integer;
355 UnitsToAssign: Boolean;
356 Adjacent: TVicinity8Loc;
357 SettlerOfJobLoc, DistToLoc: array[0..lxmax * lymax - 1] of SmallInt;
358 // DistToLoc is only defined where SettlerOfJobLoc>=0
359 TileChecked: array[0..lxmax * lymax - 1] of Boolean;
360begin
361 FillChar(SettlerOfJobLoc, MapSize * 2, $FF); // -1
362
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
366 begin
367 JobLocOfSettler[uix] := MyUnit[uix].Loc;
368 SettlerOfJobLoc[MyUnit[uix].Loc] := uix;
369 DistToLoc[MyUnit[uix].Loc] := 0;
370 end;
371
372 // assign remaining jobs to remaining settlers
373 UnitsToAssign := True;
374 while UnitsToAssign do
375 begin
376 UnitsToAssign := False;
377 for uix := 0 to RO.nUn - 1 do
378 if JobLocOfSettler[uix] = ToAssign then
379 begin
380 BestJob := jNone;
381 BestScore := -999999;
382 FillChar(TileChecked, MapSize * SizeOf(Boolean), False);
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
386 begin
387 // add surrounding tiles to queue, but only if there's a chance to beat BestScore
388 if MaxScore - DistanceScore * (TestDistance + 1) >= BestScore then
389 begin
390 V8_to_Loc(TestLoc, Adjacent);
391 for V8 := 0 to 7 do
392 begin
393 NextLoc := Adjacent[V8];
394 if (NextLoc >= 0) and not TileChecked[NextLoc] and
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
400 and ((RO.Territory[NextLoc] < 0) or
401 (RO.Territory[NextLoc] = Me)) // no foreign territory
402 and (Map[TestLoc] and Map[NextLoc] and fInEnemyZoC = 0) then
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;
407 end;
408 end;
409
410 // check tile for job
411 if (TileJob[TestLoc] > jNone) and
412 ((MyModel[MyUnit[uix].mix].Kind <> mkSlaves) or
413 (TileJob[TestLoc] <> jCity)) and
414 ((SettlerOfJobLoc[TestLoc] < 0) or (DistToLoc[TestLoc] > TestDistance)) then
415 begin
416 TestScore := Integer(TileJobScore[TestLoc]) - DistanceScore * TestDistance;
417 if TestScore > BestScore then
418 BestCount := 0;
419 if TestScore >= BestScore then
420 begin
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;
430 end;
431 TileChecked[TestLoc] := True;
432 end;
433 Pile.Free;
434
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
446 else
447 JobLocOfSettler[uix] := -1; // no jobs for this settler
448 end; // for uix
449 end;
450
451 // move settlers and start new jobs
452 for uix := 0 to RO.nUn - 1 do
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])
459 until (MoveResult < rExecuted) or (MoveResult and
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;
464end;
465
466//------------------------------------------------------------------------------
467// Map Analysis
468
469procedure TToolAI.AnalyzeMap;
470var
471 I, J, Loc, Loc1, V8, Count, Kind, MostIndex: Integer;
472 Adjacent: TVicinity8Loc;
473 IndexOfID: array[0..lxmax * lymax - 1] of SmallInt;
474 IDOfIndex: array[0..lxmax * lymax div 2 - 1] of SmallInt;
475begin
476 FillChar(District, MapSize * 4, $FF);
477 for Loc := 0 to MapSize - 1 do
478 if Map[Loc] and fTerrain = fUNKNOWN then
479 Formation[Loc] := nfUndiscovered
480 else if Map[Loc] and fTerrain = fArctic then
481 Formation[Loc] := nfPole
482 else if Map[Loc] and fPeace <> 0 then
483 Formation[Loc] := nfPeace
484 else
485 begin
486 Formation[Loc] := Loc;
487 V8_to_Loc(Loc, Adjacent);
488 for V8 := 0 to 7 do
489 begin
490 Loc1 := Adjacent[V8];
491 if (Loc1 < Loc) and (Loc1 >= 0) and (Formation[Loc1] >= 0) and
492 ((Map[Loc1] and fTerrain >= fGrass) = (Map[Loc] and fTerrain >= fGrass)) then
493 if Formation[Loc] = Loc then
494 Formation[Loc] := Formation[Loc1]
495 else if Formation[Loc] < Formation[Loc1] then
496 ReplaceD(@Formation[Formation[Loc1]], @Formation[Loc + 1],
497 Formation[Loc1], Formation[Loc])
498 else if Formation[Loc] > Formation[Loc1] then
499 ReplaceD(@Formation[Formation[Loc]], @Formation[Loc + 1],
500 Formation[Loc], Formation[Loc1]);
501 end;
502 if (RO.Territory[Loc] = Me) and (Map[Loc] and fTerrain >= fGrass) then
503 begin
504 District[Loc] := Loc;
505 for V8 := 0 to 7 do
506 begin
507 Loc1 := Adjacent[V8];
508 if (Loc1 < Loc) and (Loc1 >= 0) and (District[Loc1] >= 0) then
509 if District[Loc] = Loc then
510 District[Loc] := District[Loc1]
511 else if District[Loc] < District[Loc1] then
512 ReplaceD(@District[District[Loc1]], @District[Loc + 1],
513 District[Loc1], District[Loc])
514 else if District[Loc] > District[Loc1] then
515 ReplaceD(@District[District[Loc]], @District[Loc + 1],
516 District[Loc], District[Loc1]);
517 end;
518 end;
519 end;
520
521 // sort continents, oceans and districts by size
522 for Kind := 0 to 2 do
523 begin
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]]);
538 end;
539
540 Count := 0;
541 for Loc := 0 to MapSize - 1 do
542 if IndexOfID[Loc] > 0 then
543 begin
544 IDOfIndex[Count] := Loc;
545 Inc(Count);
546 end;
547 for I := 0 to Count - 2 do
548 begin
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
554 begin
555 J := IDOfIndex[I];
556 IDOfIndex[I] := IDOfIndex[MostIndex];
557 IDOfIndex[MostIndex] := J;
558 end;
559 end;
560 for I := 0 to Count - 1 do
561 IndexOfID[IDOfIndex[I]] := I;
562
563 case Kind of
564 0: // continents
565 begin
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]];
570 end;
571 1: // oceans
572 begin
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]];
577 end;
578 2: // districts
579 begin
580 nDistrict := Count;
581 for Loc := 0 to MapSize - 1 do
582 if District[Loc] >= 0 then
583 District[Loc] := IndexOfID[District[Loc]];
584 end;
585 end;
586 end;
587end;
588
589//------------------------------------------------------------------------------
590// Path Finding
591
592const
593 // basic move styles
594 msGround = $00000000;
595 msNoGround = $10000000;
596 msAlpine = $20000000;
597 msOver = $40000000;
598 msSpy = $50000000;
599
600 // other
601 msHostile = $08000000;
602
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 |
606
607function TToolAI.GetMyMoveStyle(mix, Health: Integer): Integer;
608begin
609 with MyModel[mix] do
610 begin
611 Result := Speed shl 16;
612 case Domain of
613 dGround:
614 begin
615 Inc(Result, (50 + (Speed - 150) * 13 shr 7) shl 8); //HeavyCost
616 if RO.Wonder[woShinkansen].EffectiveOwner <> Me then
617 Inc(Result, Speed * (4 * 1311) shr 17); // RailCost
618 if (RO.Wonder[woGardens].EffectiveOwner <> Me) or
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)
627 else
628 Inc(Result, msGround);
629 end;
630 dSea:
631 begin
632 Result := Speed;
633 if RO.Wonder[woMagellan].EffectiveOwner = Me then
634 Inc(Result, 200);
635 if Health < 100 then
636 Result := ((Result - 250) * Health div 5000) * 50 + 250;
637 Result := Result shl 16;
638 Inc(Result, msNoGround);
639 if Cap[mcNav] > 0 then
640 Inc(Result);
641 end;
642 dAir:
643 Inc(Result, msNoGround + fUNKNOWN xor 1 - 1);
644 end;
645 end;
646end;
647
648function TToolAI.CheckStep(MoveStyle, TimeBeforeStep, CrossCorner: Integer;
649 var TimeAfterStep, RecoverTurns: Integer; FromTile, ToTile: Integer;
650 IsCapture: Boolean): Integer;
651var
652 MoveCost, RecoverCost: Integer;
653begin
654 //IsCapture:=true;
655 Assert(((FromTile and fTerrain <= fMountains) or (FromTile and
656 fTerrain = fUNKNOWN)) and ((ToTile and fTerrain <= fMountains) or
657 (ToTile and fTerrain = fUNKNOWN)));
658 // do not pass location codes for FromTile and ToTile!
659 RecoverTurns := 0;
660 if MoveStyle < msGround + $10000000 then
661 begin // common ground units
662 if (ToTile + 1) and fTerrain < fGrass + 1 then
663 Result := csForbiddenTile
664 else if (ToTile and not FromTile and fPeace = 0) and
665 (ToTile and (fUnit or fOwned) <> fUnit) and
666 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then
667 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or
668 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then
669 begin // ZoC is ok
670 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then
671 begin // no railroad
672 if (ToTile and (fRoad or fRR or fCity) <> 0) and
673 (FromTile and (fRoad or fRR or fCity) <> 0) or
674 (FromTile and ToTile and (fRiver or fCanal) <> 0) then
675 MoveCost := 20 //move along road, river or canal
676 else
677 begin
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
682 begin
683 if TimeBeforeStep and $FFF + MoveStyle shr 16 and $7FF <= $800 then
684 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800
685 else
686 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $2800;
687 // must wait for next turn
688 if (MoveStyle and msHostile <> 0) and
689 ((FromTile and (fTerrain or fSpecial1) = fDesert) or
690 (FromTile and fTerrain = fArctic)) and
691 (FromTile and (fCity or fRiver or fCanal) = 0) then
692 begin
693 RecoverCost := ($800 - TimeBeforeStep and $FFF) * 5 shr 1;
694 while RecoverCost > 0 do
695 begin
696 Inc(RecoverTurns);
697 Dec(RecoverCost, MoveStyle shr 16 and $7FF);
698 end;
699 end;
700 Result := csOk;
701 if ToTile and fPeace <> 0 then
702 Result := csCheckTerritory;
703 Exit;
704 end;
705 end;
706 end;
707 end
708 else
709 MoveCost := MoveStyle and $FF; //move along railroad
710
711 Inc(MoveCost, MoveCost shl CrossCorner);
712 if (MoveStyle and msHostile = 0) or
713 (ToTile and (fTerrain or fSpecial1) <> fDesert) and
714 (ToTile and fTerrain <> fArctic) or (ToTile and
715 (fCity or fRiver or fCanal) <> 0) or (ToTile and fTerImp = tiBase) then
716 RecoverCost := 0
717 else
718 RecoverCost := (MoveCost * 5) shr 1;
719 // damage from movement: MoveCost*DesertThurst/NoCityRecovery
720 if (TimeBeforeStep and $FFF + MoveCost <= $800) and
721 (TimeBeforeStep and $FFF < $800) then
722 TimeAfterStep := TimeBeforeStep + MoveCost
723 else
724 begin
725 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 -
726 MoveStyle shr 16 and $7FF + MoveCost; // must wait for next turn
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
731 (FromTile and fTerImp <> tiBase) then
732 Inc(RecoverCost, ($800 - TimeBeforeStep and $FFF) * 5 shr 1);
733 end;
734 while RecoverCost > 0 do
735 begin
736 Inc(RecoverTurns);
737 Dec(RecoverCost, MoveStyle shr 16 and $7FF);
738 end;
739 Result := csOk;
740 if ToTile and fPeace <> 0 then
741 Result := csCheckTerritory;
742 end
743 else
744 Result := csForbiddenStep // ZoC violation
745 else
746 Result := csForbiddenTile;
747 end
748
749 else if MoveStyle < msNoGround + $10000000 then
750 begin // ships and aircraft
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
754 (fCity or fOwned) = fCity) then
755 Result := csForbiddenTile
756 else
757 begin
758 MoveCost := 50 shl CrossCorner + 50;
759 if TimeBeforeStep and $FFF + MoveCost <= $800 then
760 TimeAfterStep := TimeBeforeStep + MoveCost
761 else
762 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 -
763 MoveStyle shr 16 and $7FF + MoveCost;
764 // must wait for next turn
765 Result := csOk;
766 if ToTile and fPeace <> 0 then
767 Result := csCheckTerritory;
768 end;
769 end
770
771 else if MoveStyle < msAlpine + $10000000 then
772 begin // alpine
773 if (ToTile + 1) and fTerrain < fGrass + 1 then
774 Result := csForbiddenTile
775 else if (ToTile and not FromTile and fPeace = 0) and
776 (ToTile and (fUnit or fOwned) <> fUnit) and
777 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then
778 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or
779 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then
780 begin
781 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then
782 MoveCost := 20 // no railroad
783 else
784 MoveCost := MoveStyle and $FF; //move along railroad
785 Inc(MoveCost, MoveCost shl CrossCorner);
786 if (TimeBeforeStep and $FFF + MoveCost <= $800) and
787 (TimeBeforeStep and $FFF < $800) then
788 TimeAfterStep := TimeBeforeStep + MoveCost
789 else
790 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 -
791 MoveStyle shr 16 and $7FF + MoveCost;
792 // must wait for next turn
793 Result := csOk;
794 if ToTile and fPeace <> 0 then
795 Result := csCheckTerritory;
796 end
797 else
798 Result := csForbiddenStep // ZoC violation
799 else
800 Result := csForbiddenTile;
801 end
802
803 else if MoveStyle < msOver + $10000000 then
804 begin // overweight
805 if (ToTile + 1) and fTerrain < fGrass + 1 then
806 Result := csForbiddenTile
807 else if (ToTile and not FromTile and fPeace = 0) and
808 (ToTile and (fUnit or fOwned) <> fUnit) and
809 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then
810 if (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or fOwned) or
811 (ToTile and FromTile and (fInEnemyZoc or fOwnZoCUnit) <> fInEnemyZoc) then
812 begin
813 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then
814 begin // no railroad
815 if (ToTile and (fRoad or fRR or fCity) <> 0) and
816 (FromTile and (fRoad or fRR or fCity) <> 0) or
817 (FromTile and ToTile and (fRiver or fCanal) <> 0) then
818 MoveCost := 40 //move along road, river or canal
819 else
820 begin
821 Result := csForbiddenTile;
822 Exit;
823 end;
824 end
825 else
826 MoveCost := MoveStyle and $FF; //move along railroad
827 Inc(MoveCost, MoveCost shl CrossCorner);
828 if (TimeBeforeStep and $FFF + MoveCost <= $800) and
829 (TimeBeforeStep and $FFF < $800) then
830 TimeAfterStep := TimeBeforeStep + MoveCost
831 else
832 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 -
833 MoveStyle shr 16 and $7FF + MoveCost;
834 // must wait for next turn
835 Result := csOk;
836 if ToTile and fPeace <> 0 then
837 Result := csCheckTerritory;
838 end
839 else
840 Result := csForbiddenStep // ZoC violation
841 else
842 Result := csForbiddenTile;
843 end
844
845 else {if MoveStyle<msSpy+$10000000 then}
846 begin // spies
847 if (ToTile + 1) and fTerrain < fGrass + 1 then
848 Result := csForbiddenTile
849 else if (ToTile and (fUnit or fOwned) <> fUnit) and
850 (IsCapture or (ToTile and (fCity or fOwned) <> fCity)) then
851 begin
852 if (ToTile and (fRR or fCity) = 0) or (FromTile and (fRR or fCity) = 0) then
853 begin // no railroad
854 if (ToTile and (fRoad or fRR or fCity) <> 0) and
855 (FromTile and (fRoad or fRR or fCity) <> 0) or
856 (FromTile and ToTile and (fRiver or fCanal) <> 0) then
857 MoveCost := 20 //move along road, river or canal
858 else
859 begin
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
864 begin
865 if TimeBeforeStep and $FFF + MoveStyle shr 16 and $7FF <= $800 then
866 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800
867 else
868 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $2800;
869 // must wait for next turn
870 Result := csOk;
871 Exit;
872 end;
873 end;
874 end;
875 end
876 else
877 MoveCost := MoveStyle and $FF; //move along railroad
878 Inc(MoveCost, MoveCost shl CrossCorner);
879 if (TimeBeforeStep and $FFF + MoveCost <= $800) and
880 (TimeBeforeStep and $FFF < $800) then
881 TimeAfterStep := TimeBeforeStep + MoveCost
882 else
883 TimeAfterStep := TimeBeforeStep and $7FFFF000 + $1800 -
884 MoveStyle shr 16 and $7FF + MoveCost;
885 // must wait for next turn
886 Result := csOk;
887 end
888 else
889 Result := csForbiddenTile;
890 end;
891end;
892
893(*
894-------- Pathfinding Reference Implementation --------
895var
896MoveStyle,V8,Loc,Time,NextLoc,NextTime,RecoverTurns: Integer;
897Adjacent: TVicinity8Loc;
898Reached: array[0..lxmax*lymax-1] of Boolean;
899begin
900FillChar(Reached, MapSize, False);
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
905 begin
906 // todo: check exit condition, e.g. whether destination reached
907
908 Reached[Loc]:=True;
909 V8_to_Loc(Loc, Adjacent);
910 for V8:=0 to 7 do
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:
918 Reached[NextLoc]:=True; // don't check moving there again
919 csCheckTerritory:
920 if RO.Territory[NextLoc]=RO.Territory[Loc] then
921 Pile.Put(NextLoc, NextTime+RecoverTurns*$1000);
922 end
923 end;
924 end;
925Pile.Free;
926end;
927*)
928
929function TToolAI.Unit_MoveEx(uix, ToLoc: Integer; Options: Integer): Integer;
930var
931 Loc, NextLoc, Temp, FromLoc, EndLoc, Time, V8, MoveResult, RecoverTurns,
932 NextTime, MoveStyle: Integer;
933 Adjacent: TVicinity8Loc;
934 PreLoc: array[0..lxmax * lymax - 1] of Integer;
935 Reached: array[0..lxmax * lymax - 1] of Boolean;
936begin
937 Result := eOk;
938 FromLoc := MyUnit[uix].Loc;
939 if FromLoc = ToLoc then
940 Exit;
941
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
948 begin
949 if (Loc = ToLoc) or (ToLoc = maNextCity) and (Map[Loc] and fCity <> 0) and
950 (Map[Loc] and fOwned <> 0) then
951 begin
952 EndLoc := Loc;
953 Break;
954 end;
955 Reached[Loc] := True;
956 V8_to_Loc(Loc, Adjacent);
957 for V8 := 0 to 7 do
958 begin
959 NextLoc := Adjacent[V8];
960 if NextLoc >= 0 then
961 if (NextLoc = ToLoc) and (Options and mxAdjacent <> 0) then
962 begin
963 EndLoc := Loc;
964 Break;
965 end
966 else if not Reached[NextLoc] then
967 begin
968 case CheckStep(MoveStyle, Time, V8 and 1, NextTime, RecoverTurns,
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;
981 end;
982 if EndLoc >= 0 then
983 Break;
984 end;
985 Pile.Free;
986
987 if EndLoc >= 0 then
988 begin
989 Loc := EndLoc;
990 NextLoc := PreLoc[Loc];
991 while Loc <> FromLoc do
992 begin // invert meaning of PreLoc
993 Temp := Loc;
994 Loc := NextLoc;
995 NextLoc := PreLoc[Loc];
996 PreLoc[Loc] := Temp;
997 end;
998 while Loc <> EndLoc do
999 begin
1000 Loc := PreLoc[Loc];
1001 MoveResult := Unit_Step(uix, Loc);
1002 if (MoveResult <> eOK) and (MoveResult <> eLoaded) then
1003 begin
1004 Result := MoveResult;
1005 Break;
1006 end;
1007 end;
1008 end
1009 else
1010 Result := eNoWay;
1011end;
1012
1013//------------------------------------------------------------------------------
1014// Oversea Transport
1015
1016procedure TToolAI.SeaTransport_BeginInitialize;
1017begin
1018 FillChar(TransportAvailable, RO.nUn * SizeOf(Integer), $FF); // -1
1019 InitComplete := False;
1020 HaveDestinations := False;
1021 nTransportLoad := 0;
1022 TransportMoveStyle := 0;
1023 TransportCapacity := $100;
1024 Pile.Create(MapSize);
1025end;
1026
1027procedure TToolAI.SeaTransport_AddLoad(uix: Integer);
1028var
1029 I: Integer;
1030begin
1031 Assert(not InitComplete); // call order violation!
1032 if Map[MyUnit[uix].Loc] and fTerrain < fGrass then
1033 Exit;
1034 for I := 0 to nTransportLoad - 1 do
1035 if uix = uixTransportLoad[I] then
1036 Exit;
1037 uixTransportLoad[nTransportLoad] := uix;
1038 Inc(nTransportLoad);
1039end;
1040
1041procedure TToolAI.SeaTransport_AddTransport(uix: Integer);
1042var
1043 MoveStyle: Integer;
1044begin
1045 Assert(not InitComplete); // call order violation!
1046 Assert(MyModel[MyUnit[uix].mix].Cap[mcSeaTrans] > 0);
1047 TransportAvailable[uix] := 1;
1048 with MyModel[MyUnit[uix].mix] do
1049 begin
1050 if MTrans * Cap[mcSeaTrans] < TransportCapacity then
1051 TransportCapacity := MTrans * Cap[mcSeaTrans];
1052 MoveStyle := GetMyMoveStyle(MyUnit[uix].mix, 100);
1053 if (TransportMoveStyle = 0) or (MoveStyle < TransportMoveStyle) and
1054 (MoveStyle and not TransportMoveStyle and 1 = 0) or
1055 (not MoveStyle and TransportMoveStyle and 1 <> 0) then
1056 TransportMoveStyle := MoveStyle;
1057 end;
1058end;
1059
1060procedure TToolAI.SeaTransport_AddDestination(Loc: Integer);
1061begin
1062 Assert(not InitComplete); // call order violation!
1063 Pile.Put(Loc, $800);
1064 HaveDestinations := True;
1065end;
1066
1067procedure TToolAI.SeaTransport_EndInitialize;
1068var
1069 Loc0, Time0, V8, Loc1, ArriveTime, RecoverTurns: Integer;
1070 Adjacent: TVicinity8Loc;
1071begin
1072 Assert(not InitComplete); // call order violation!
1073 InitComplete := True;
1074 if HaveDestinations then
1075 begin // calculate TurnsAfterLoad from destination locs
1076 FillChar(TurnsAfterLoad, MapSize, $FF); // -1
1077 while Pile.Get(Loc0, Time0) do
1078 begin // search backward
1079 if Time0 = $800 then
1080 TurnsAfterLoad[Loc0] := 1
1081 else
1082 TurnsAfterLoad[Loc0] := Time0 shr 12;
1083 V8_to_Loc(Loc0, Adjacent);
1084 for V8 := 0 to 7 do
1085 begin
1086 Loc1 := Adjacent[V8];
1087 if (Loc1 >= 0) and (TurnsAfterLoad[Loc1] = -1) then
1088 begin
1089 case CheckStep(TransportMoveStyle, Time0, V8 and 1, ArriveTime,
1090 RecoverTurns, Map[Loc0], Map[Loc1], False) of
1091 csOk: Pile.Put(Loc1, ArriveTime);
1092 csForbiddenStep: TurnsAfterLoad[Loc1] := -2;
1093 end;
1094 end;
1095 end;
1096 end;
1097 end;
1098 Pile.Free;
1099end;
1100
1101function TToolAI.SeaTransport_MakeGroupPlan(
1102 var TransportPlan: TGroupTransportPlan): Boolean;
1103var
1104 V8, I, J, iPicked, uix, Loc0, Time0, Loc1, RecoverTurns, MoveStyle,
1105 TurnsLoaded, TurnCount, tuix, tuix1, ArriveTime, TotalDelay,
1106 BestTotalDelay, GroupCount, BestGroupCount, BestLoadLoc, FullMovementLoc,
1107 nSelectedLoad, F, OriginContinent, A, B: Integer;
1108 CompleteFlag, NotReachedFlag, ContinueUnit: Cardinal;
1109 IsComplete, Ok, IsFirstLoc: Boolean;
1110 StartLocPtr, ArrivedEnd: pinteger;
1111 Adjacent: TVicinity8Loc;
1112 uixSelectedLoad: array[0..15] of Integer;
1113 tuixSelectedLoad: array[0..15] of Integer;
1114 Arrived: array[0..lxmax * lymax] of Cardinal;
1115 ResponsibleTransport: array[0..lxmax * lymax - 1] of SmallInt;
1116 TurnsBeforeLoad: array[0..lxmax * lymax - 1] of ShortInt;
1117 GroupComplete: array[0..lxmax * lymax - 1] of Boolean;
1118begin
1119 Assert(InitComplete); // call order violation!
1120
1121 if HaveDestinations and (nTransportLoad > 0) then
1122 begin // transport and units already adjacent?
1123 for uix := 0 to RO.nUn - 1 do
1124 if (TransportAvailable[uix] > 0) and (Map[MyUnit[uix].Loc] and
1125 fTerrain = fShore) then
1126 begin
1127 GroupCount := 0;
1128 for tuix := 0 to nTransportLoad - 1 do
1129 begin
1130 Loc_to_ab(MyUnit[uix].Loc, MyUnit[uixTransportLoad[tuix]].Loc, A, B);
1131 if (Abs(A) <= 1) and (Abs(B) <= 1) then
1132 begin
1133 Assert((A <> 0) or (B <> 0));
1134 Inc(GroupCount);
1135 end;
1136 end;
1137 if (GroupCount = nTransportLoad) or (GroupCount >= TransportCapacity) then
1138 begin
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
1146 begin
1147 Loc_to_ab(TransportPlan.LoadLoc, MyUnit[uixTransportLoad[tuix]].Loc, A, B);
1148 if (Abs(A) <= 1) and (Abs(B) <= 1) then
1149 begin
1150 TransportPlan.uixLoad[TransportPlan.nLoad] := uixTransportLoad[tuix];
1151 uixTransportLoad[tuix] := uixTransportLoad[nTransportLoad - 1];
1152 Dec(nTransportLoad);
1153 Inc(TransportPlan.nLoad);
1154 if TransportPlan.nLoad = TransportCapacity then
1155 Break;
1156 end;
1157 end;
1158 Result := True;
1159 Exit;
1160 end;
1161 end;
1162 end;
1163
1164 while HaveDestinations and (nTransportLoad > 0) do
1165 begin
1166 // select units from same continent
1167 FillChar(Arrived, 4 * nContinent, 0); // misuse Arrived as counter
1168 for tuix := 0 to nTransportLoad - 1 do
1169 begin
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]);
1174 end;
1175 OriginContinent := 0;
1176 for F := 1 to nContinent - 1 do
1177 if Arrived[F] > Arrived[OriginContinent] then
1178 OriginContinent := F;
1179 nSelectedLoad := 0;
1180 for tuix := 0 to nTransportLoad - 1 do
1181 if Formation[MyUnit[uixTransportLoad[tuix]].Loc] = OriginContinent then
1182 begin
1183 tuixSelectedLoad[nSelectedLoad] := tuix;
1184 uixSelectedLoad[nSelectedLoad] := uixTransportLoad[tuix];
1185 Inc(nSelectedLoad);
1186 if nSelectedLoad = 16 then
1187 Break;
1188 end;
1189
1190 Pile.Create(MapSize);
1191 FillChar(ResponsibleTransport, MapSize * 2, $FF); // -1
1192 FillChar(TurnsBeforeLoad, MapSize, $FF); // -1
1193 Ok := False;
1194 for uix := 0 to RO.nUn - 1 do
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
1201 begin
1202 TransportPlan.LoadLoc := -1;
1203 Result := False;
1204 Pile.Free;
1205 Exit;
1206 end;
1207 while Pile.Get(Loc0, Time0) do
1208 begin
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
1215 begin
1216 Loc1 := Adjacent[V8];
1217 if (Loc1 >= 0) and (ResponsibleTransport[Loc1] < 0) then
1218 case CheckStep(GetMyMoveStyle(MyUnit[uix].mix, MyUnit[uix].Health),
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;
1224 end;
1225
1226 FillChar(Arrived, MapSize * 4, $55); // set NotReachedFlag for all tiles
1227 FillChar(GroupComplete, MapSize, False);
1228 BestLoadLoc := -1;
1229
1230 // check direct loading
1231 for tuix := 0 to nSelectedLoad - 1 do
1232 begin
1233 uix := uixSelectedLoad[tuix];
1234 if MyUnit[uix].Movement = Integer(MyModel[MyUnit[uix].mix].Speed) then
1235 begin
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
1240 begin
1241 Loc1 := Adjacent[V8];
1242 if (Loc1 >= 0) and (Map[Loc1] and fTerrain < fGrass) and
1243 not GroupComplete[Loc1] then
1244 begin // possible transport start location
1245 Arrived[Loc1] := (Arrived[Loc1] or CompleteFlag) and not NotReachedFlag;
1246 if (TurnsBeforeLoad[Loc1] >= 0) and (TurnsAfterLoad[Loc1] >= 0) then
1247 begin
1248 I := 1;
1249 GroupCount := 0;
1250 for tuix1 := 0 to nSelectedLoad - 1 do
1251 begin
1252 if Arrived[loc1] and I = 0 then
1253 Inc(GroupCount);
1254 I := I shl 2;
1255 end;
1256 Assert(GroupCount <= TransportCapacity);
1257 if (GroupCount = TransportCapacity) or (GroupCount = nSelectedLoad) then
1258 GroupComplete[loc1] := True;
1259 TotalDelay := TurnsBeforeLoad[Loc1] + TurnsAfterLoad[Loc1];
1260 if (BestLoadLoc < 0) or (GroupCount shl 16 -
1261 TotalDelay > BestGroupCount shl 16 - BestTotalDelay) then
1262 begin
1263 BestLoadLoc := Loc1;
1264 BestGroupCount := GroupCount;
1265 BestTotalDelay := TotalDelay;
1266 end;
1267 end;
1268 end;
1269 end;
1270 end;
1271 end;
1272
1273 TurnCount := 0;
1274 ArrivedEnd := @Arrived[MapSize];
1275
1276 // check moving+loading
1277 ContinueUnit := 1 shl nSelectedLoad - 1;
1278 while (ContinueUnit > 0) and ((BestLoadLoc < 0) or
1279 (TurnCount < BestTotalDelay - 2)) do
1280 begin
1281 for tuix := 0 to nSelectedLoad - 1 do
1282 if 1 shl tuix and ContinueUnit <> 0 then
1283 begin
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;
1289
1290 Pile.Empty;
1291 if TurnCount = 0 then
1292 begin
1293 Pile.Put(MyUnit[uix].Loc, $1800 - MyUnit[uix].Movement);
1294 if MyUnit[uix].Movement = Integer(MyModel[MyUnit[uix].mix].Speed) then
1295 FullMovementLoc := MyUnit[uix].Loc;
1296 // surrounding tiles can be loaded immediately
1297 StartLocPtr := ArrivedEnd;
1298 end
1299 else
1300 StartLocPtr := @Arrived;
1301 IsFirstLoc := True;
1302
1303 repeat
1304 if StartLocPtr <> ArrivedEnd then
1305 // search next movement start location for this turn
1306 StartLocPtr := NextZero(StartLocPtr, ArrivedEnd,
1307 CompleteFlag or NotReachedFlag);
1308 if StartLocPtr <> ArrivedEnd then
1309 begin
1310 Loc0 := (Integer(StartLocPtr) - Integer(@Arrived)) shr 2;
1311 Inc(StartLocPtr);
1312 Time0 := $800;
1313 end
1314 else if not Pile.Get(Loc0, Time0) then
1315 begin
1316 if IsFirstLoc then
1317 ContinueUnit := ContinueUnit and not (1 shl tuix);
1318 Break;
1319 end;
1320 IsFirstLoc := False;
1321
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
1325 I := 1;
1326 GroupCount := 0;
1327 for tuix1 := 0 to nSelectedLoad - 1 do
1328 begin
1329 if Arrived[Loc0] and I = 0 then
1330 Inc(GroupCount);
1331 I := I shl 2;
1332 end;
1333 Assert(GroupCount <= TransportCapacity);
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
1354 begin
1355 I := 1;
1356 GroupCount := 0;
1357 for tuix1 := 0 to nSelectedLoad - 1 do
1358 begin
1359 if Arrived[loc1] and I = 0 then
1360 Inc(GroupCount);
1361 I := I shl 2;
1362 end;
1363 Assert(GroupCount <= TransportCapacity);
1364 if (GroupCount = TransportCapacity) or
1365 (GroupCount = nSelectedLoad) then
1366 GroupComplete[loc1] := True;
1367 if TurnsBeforeLoad[Loc1] > TurnCount + 1 then
1368 TotalDelay := TurnsBeforeLoad[Loc1] + TurnsAfterLoad[Loc1]
1369 else
1370 TotalDelay := TurnCount + 1 + TurnsAfterLoad[Loc1];
1371 if (BestLoadLoc < 0) or (GroupCount shl
1372 16 - TotalDelay > BestGroupCount shl 16 - BestTotalDelay) then
1373 begin
1374 BestLoadLoc := Loc1;
1375 BestGroupCount := GroupCount;
1376 BestTotalDelay := TotalDelay;
1377 end;
1378 end;
1379 end
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
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
1388 else
1389 IsComplete := False;
1390 end;
1391 if IsComplete then
1392 begin
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;
1403 case CheckStep(MoveStyle, Time0, V8 and 1, ArriveTime,
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
1412 if ArriveTime < $2000 then
1413 Pile.Put(Loc1, ArriveTime)
1414 else
1415 IsComplete := False;
1416 end;
1417 end;
1418 if IsComplete then
1419 Arrived[Loc0] := (Arrived[Loc0] or CompleteFlag) and not NotReachedFlag;
1420 until False;
1421 end;
1422
1423 Inc(TurnCount);
1424 end;
1425 Pile.Free;
1426
1427 if BestLoadLoc >= 0 then
1428 begin
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
1437 begin
1438 Assert(uixTransportLoad[tuixSelectedLoad[tuix]] = uixSelectedLoad[tuix]);
1439 TransportPlan.uixLoad[TransportPlan.nLoad] := uixSelectedLoad[tuix];
1440 uixTransportLoad[tuixSelectedLoad[tuix]] :=
1441 uixTransportLoad[nTransportLoad - 1];
1442 Dec(nTransportLoad);
1443 Inc(TransportPlan.nLoad);
1444 end;
1445 Result := True;
1446 Exit;
1447 end;
1448
1449 // no loading location for a single of these units -- remove all
1450 // should be pretty rare case
1451 for tuix := nSelectedLoad - 1 downto 0 do
1452 begin
1453 Assert(uixTransportLoad[tuixSelectedLoad[tuix]] = uixSelectedLoad[tuix]);
1454 uixTransportLoad[tuixSelectedLoad[tuix]] :=
1455 uixTransportLoad[nTransportLoad - 1];
1456 Dec(nTransportLoad);
1457 end;
1458 end;
1459 TransportPlan.LoadLoc := -1;
1460 Result := False;
1461end;
1462
1463//------------------------------------------------------------------------------
1464// Misc
1465
1466function TToolAI.CurrentMStrength(Domain: Integer): Integer;
1467var
1468 I: Integer;
1469begin
1470 Result := 0;
1471 for I := 0 to nUpgrade - 1 do
1472 with upgrade[Domain, I] do
1473 if (Preq = preNone) or (Preq >= 0) and
1474 ((RO.Tech[Preq] >= tsApplicable) or (Preq in FutureTech) and
1475 (RO.Tech[Preq] >= 0)) then
1476 begin
1477 if Preq in FutureTech then
1478 Inc(Result, RO.Tech[Preq] * Strength)
1479 else
1480 Inc(Result, Strength);
1481 end;
1482end;
1483
1484//------------------------------------------------------------------------------
1485
1486procedure SetAdvancedness;
1487var
1488 ad, J, Reduction, AgeThreshold: Integer;
1489 known: array[0..nAdv - 1] of Integer;
1490
1491 procedure MarkPreqs(ad: Integer);
1492 var
1493 I: Integer;
1494 begin
1495 if known[ad] = 0 then
1496 begin
1497 known[ad] := 1;
1498 for I := 0 to 2 do
1499 if AdvPreq[ad, I] >= 0 then
1500 MarkPreqs(AdvPreq[ad, I]);
1501 end;
1502 end;
1503
1504begin
1505 FillChar(Advancedness, SizeOf(Advancedness), 0);
1506 for ad := 0 to nAdv - 1 do
1507 begin
1508 FillChar(known, SizeOf(known), 0);
1509 MarkPreqs(ad);
1510 for J := 0 to nAdv - 1 do
1511 if known[J] > 0 then
1512 Inc(Advancedness[ad]);
1513 end;
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);
1524end;
1525
1526
1527initialization
1528 SetAdvancedness;
1529
1530end.
Note: See TracBrowser for help on using the repository browser.