source: tags/1.3.4/AI Template/ToolAI.pas

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