source: tags/1.2.0/AI/StdAI/ToolAI.pas

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