source: branches/zoom/AI/StdAI/CustomAI.pas

Last change on this file was 663, checked in by chronos, 2 months ago
  • Fixed: Fixed unit move style hostile calculation in StdAI. Engineers don't take hostile damage on hostile terrain.
File size: 31.9 KB
Line 
1{$INCLUDE Switches.inc}
2unit CustomAI;
3
4interface
5
6uses
7{$IFDEF DEBUG}SysUtils,{$ENDIF} // necessary for debug exceptions
8 Protocol;
9
10type
11 TNegoTime = (BeginOfTurn, EndOfTurn, EnemyCalled);
12
13 TCustomAI = class
14 public
15 procedure Process(Command: Integer; var Data);
16
17 // overridables
18 constructor Create(Nation: Integer); virtual;
19 destructor Destroy; override;
20 procedure SetDataDefaults; virtual;
21 procedure SetDataRandom; virtual;
22 procedure OnBeforeEnemyAttack(UnitInfo: TUnitInfo;
23 ToLoc, EndHealth, EndHealthDef: Integer); virtual;
24 procedure OnBeforeEnemyCapture(UnitInfo: TUnitInfo; ToLoc: Integer); virtual;
25 procedure OnAfterEnemyAttack; virtual;
26 procedure OnAfterEnemyCapture; virtual;
27
28 protected
29 Me: Integer; // index of the controlled nation
30 RO: ^TPlayerContext;
31 Map: ^TTileList;
32 MyUnit: ^TUnList;
33 MyCity: ^TCityList;
34 MyModel: ^TModelList;
35
36 cixStateImp: array[imPalace..imSpacePort] of Integer;
37
38 // negotiation
39 Opponent: Integer; // nation i'm in negotiation with, -1 indicates no-negotiation mode
40 MyAction, MyLastAction, OppoAction: Integer;
41 MyOffer, MyLastOffer, OppoOffer: TOffer;
42
43 // overridables
44 procedure DoTurn; virtual;
45 procedure DoNegotiation; virtual;
46 function ChooseResearchAdvance: Integer; virtual;
47 function ChooseStealAdvance: Integer; virtual;
48 function ChooseGovernment: Integer; virtual;
49 function WantNegotiation(Nation: Integer; NegoTime: TNegoTime): Boolean; virtual;
50 function OnNegoRejected_CancelTreaty: Boolean; virtual;
51
52 // general functions
53 function IsResearched(Advance: Integer): Boolean;
54 function ResearchCost: Integer;
55 function ChangeAttitude(Nation, Attitude: Integer): Integer;
56 function Revolution: Integer;
57 function ChangeRates(Tax, Lux: Integer): Integer;
58 function PrepareNewModel(Domain: Integer): Integer;
59 function SetNewModelFeature(F, Count: Integer): Integer;
60 function AdvanceResearchable(Advance: Integer): Boolean;
61 function AdvanceStealable(Advance: Integer): Boolean;
62 function GetJobProgress(Loc: Integer; var JobProgress: TJobProgressData): Boolean;
63 function DebugMessage(Level: Integer; Text: string): Boolean;
64 function SetDebugMap(var DebugMap): Boolean;
65
66 // unit functions
67 procedure Unit_FindMyDefender(Loc: Integer; var uix: Integer);
68 procedure Unit_FindEnemyDefender(Loc: Integer; var euix: Integer);
69 function Unit_Move(uix, ToLoc: Integer): Integer;
70 function Unit_Step(uix, ToLoc: Integer): Integer;
71 function Unit_Attack(uix, ToLoc: Integer): Integer;
72 function Unit_DoMission(uix, MissionType, ToLoc: Integer): Integer;
73 function Unit_MoveForecast(uix, ToLoc: Integer;
74 var RemainingMovement: Integer): Boolean;
75 function Unit_AttackForecast(uix, ToLoc, AttackMovement: Integer;
76 var RemainingHealth: Integer): Boolean;
77 function Unit_DefenseForecast(euix, ToLoc: Integer;
78 var RemainingHealth: Integer): Boolean;
79 function Unit_Disband(uix: Integer): Integer;
80 function Unit_StartJob(uix, NewJob: Integer): Integer;
81 function Unit_SetHomeHere(uix: Integer): Integer;
82 function Unit_Load(uix: Integer): Integer;
83 function Unit_Unload(uix: Integer): Integer;
84 function Unit_SelectTransport(uix: Integer): Integer;
85 function Unit_AddToCity(uix: Integer): Integer;
86
87 // city functions
88 procedure City_FindMyCity(Loc: Integer; var cix: Integer);
89 procedure City_FindEnemyCity(Loc: Integer; var ecix: Integer);
90 function City_HasProject(cix: Integer): Boolean;
91 function City_CurrentImprovementProject(cix: Integer): Integer;
92 function City_CurrentUnitProject(cix: Integer): Integer;
93 function City_GetTileInfo(cix, TileLoc: Integer; var TileInfo: TTileInfo): Integer;
94 function City_GetReport(cix: Integer; var Report: TCityReport): Integer;
95 function City_GetHypoReport(cix, HypoTiles, HypoTax, HypoLux: Integer;
96 var Report: TCityReport): Integer;
97 function City_GetReportNew(cix: Integer; var Report: TCityReportNew): Integer;
98 function City_GetHypoReportNew(cix, HypoTiles, HypoTaxRate, HypoLuxuryRate: Integer;
99 var Report: TCityReportNew): Integer;
100 function City_GetAreaInfo(cix: Integer; var AreaInfo: TCityAreaInfo): Integer;
101 function City_StartUnitProduction(cix, mix: Integer): Integer;
102 function City_StartEmigration(cix, mix: Integer;
103 AllowDisbandCity, AsConscripts: Boolean): Integer;
104 function City_StartImprovement(cix, iix: Integer): Integer;
105 function City_Improvable(cix, iix: Integer): Boolean;
106 function City_StopProduction(cix: Integer): Integer;
107 function City_BuyProject(cix: Integer): Integer;
108 function City_SellImprovement(cix, iix: Integer): Integer;
109 function City_RebuildImprovement(cix, iix: Integer): Integer;
110 function City_SetTiles(cix, NewTiles: Integer): Integer;
111 procedure City_OptimizeTiles(cix: Integer; ResourceWeights: Cardinal = rwMaxGrowth);
112
113 // negotiation
114 function Nego_CheckMyAction: Integer;
115
116 private
117 HaveTurned: Boolean;
118 UnwantedNego: set of 0..nPl - 1;
119 Contacted: set of 0..nPl - 1;
120 procedure StealAdvance;
121 end;
122
123
124var
125 Server: TServerCall;
126 G: TNewGameData;
127 RWDataSize, MapSize: Integer;
128 decompose24: Cardinal;
129 nodata: Pointer;
130
131const
132 CityOwnTile = 13; // = ab_to_V21(0,0)
133
134 // additional return codes
135 rLocationReached = $00010000;
136 // Unit_Move: move was not interrupted, location reached
137 rMoreTurns = $00020000;
138// Unit_Move: move was not interrupted, location not reached yet
139
140type
141 TVicinity8Loc = array[0..7] of Integer;
142 TVicinity21Loc = array[0..27] of Integer;
143
144
145procedure Init(NewGameData: TNewGameData);
146
147procedure ab_to_Loc(Loc0, A, B: Integer; var Loc: Integer);
148procedure Loc_to_ab(Loc0, Loc: Integer; var A, B: Integer);
149procedure ab_to_V8(A, B: Integer; var V8: Integer);
150procedure V8_to_ab(V8: Integer; var A, B: Integer);
151procedure ab_to_V21(A, B: Integer; var V21: Integer);
152procedure V21_to_ab(V21: Integer; var A, B: Integer);
153procedure V8_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity8Loc);
154procedure V21_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity21Loc);
155function Distance(Loc0, Loc1: Integer): Integer;
156
157
158implementation
159
160const
161 ab_v8: array[-4..4] of Integer = (5, 6, 7, 4, -1, 0, 3, 2, 1);
162 v8_a: array[0..7] of Integer = (1, 1, 0, -1, -1, -1, 0, 1);
163 v8_b: array[0..7] of Integer = (0, 1, 1, 1, 0, -1, -1, -1);
164
165
166procedure ab_to_Loc(Loc0, A, B: Integer; var Loc: Integer);
167{relative location from Loc0}
168var
169 y0: Integer;
170begin
171 Assert((Loc0 >= 0) and (Loc0 < MapSize) and (A - B + G.lx >= 0));
172 y0 := Cardinal(Loc0) * decompose24 shr 24;
173 Loc := (Loc0 + (A - B + y0 and 1 + G.lx + G.lx) shr 1) mod G.lx + G.lx * (y0 + A + B);
174 if Loc >= MapSize then
175 Loc := -$1000;
176end;
177
178procedure Loc_to_ab(Loc0, Loc: Integer; var A, B: Integer);
179var
180 dx, dy: Integer;
181begin
182 dx := ((Loc mod G.lx * 2 + Loc div G.lx and 1) - (Loc0 mod G.lx * 2 + Loc0 div
183 G.lx and 1) + 3 * G.lx) mod (2 * G.lx) - G.lx;
184 dy := Loc div G.lx - Loc0 div G.lx;
185 A := (dx + dy) div 2;
186 B := (dy - dx) div 2;
187end;
188
189procedure ab_to_V8(A, B: Integer; var V8: Integer);
190begin
191 Assert((Abs(A) <= 1) and (Abs(B) <= 1) and ((A <> 0) or (B <> 0)));
192 V8 := ab_v8[2 * B + B + A];
193end;
194
195procedure V8_to_ab(V8: Integer; var A, B: Integer);
196begin
197 A := v8_a[V8];
198 B := V8_b[V8];
199end;
200
201procedure ab_to_V21(A, B: Integer; var V21: Integer);
202begin
203 V21 := (A + B + 3) shl 2 + (A - B + 3) shr 1;
204end;
205
206procedure V21_to_ab(V21: Integer; var A, B: Integer);
207var
208 dx, dy: Integer;
209begin
210 dy := V21 shr 2 - 3;
211 dx := V21 and 3 shl 1 - 3 + (dy + 3) and 1;
212 A := (dx + dy) div 2;
213 B := (dy - dx) div 2;
214end;
215
216procedure V8_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity8Loc);
217var
218 x0, y0, lx: Integer;
219begin
220 lx := G.lx;
221 y0 := Cardinal(Loc0) * decompose24 shr 24;
222 x0 := Loc0 - y0 * lx; // Loc0 mod lx;
223 VicinityLoc[1] := Loc0 + lx * 2;
224 VicinityLoc[3] := Loc0 - 1;
225 VicinityLoc[5] := Loc0 - lx * 2;
226 VicinityLoc[7] := Loc0 + 1;
227 Inc(Loc0, y0 and 1);
228 VicinityLoc[0] := Loc0 + lx;
229 VicinityLoc[2] := Loc0 + lx - 1;
230 VicinityLoc[4] := Loc0 - lx - 1;
231 VicinityLoc[6] := Loc0 - lx;
232
233 // world is round!
234 if x0 < lx - 1 then
235 begin
236 if x0 = 0 then
237 begin
238 Inc(VicinityLoc[3], lx);
239 if y0 and 1 = 0 then
240 begin
241 Inc(VicinityLoc[2], lx);
242 Inc(VicinityLoc[4], lx);
243 end;
244 end;
245 end
246 else
247 begin
248 Dec(VicinityLoc[7], lx);
249 if y0 and 1 = 1 then
250 begin
251 Dec(VicinityLoc[0], lx);
252 Dec(VicinityLoc[6], lx);
253 end;
254 end;
255
256 // check south pole
257 case G.ly - y0 of
258 1:
259 begin
260 VicinityLoc[0] := -$1000;
261 VicinityLoc[1] := -$1000;
262 VicinityLoc[2] := -$1000;
263 end;
264 2: VicinityLoc[1] := -$1000;
265 end;
266end;
267
268procedure V21_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity21Loc);
269var
270 dx, dy, bit, y0, xComp, yComp, xComp0, xCompSwitch: Integer;
271 dst: ^Integer;
272begin
273 y0 := Cardinal(Loc0) * decompose24 shr 24;
274 xComp0 := Loc0 - y0 * G.lx - 1; // Loc0 mod G.lx -1
275 xCompSwitch := xComp0 - 1 + y0 and 1;
276 if xComp0 < 0 then
277 Inc(xComp0, G.lx);
278 if xCompSwitch < 0 then
279 Inc(xCompSwitch, G.lx);
280 xCompSwitch := xCompSwitch xor xComp0;
281 yComp := G.lx * (y0 - 3);
282 dst := @VicinityLoc;
283 bit := 1;
284 for dy := 0 to 6 do
285 if yComp < MapSize then
286 begin
287 xComp0 := xComp0 xor xCompSwitch;
288 xComp := xComp0;
289 for dx := 0 to 3 do
290 begin
291 if bit and $67F7F76 <> 0 then
292 dst^ := xComp + yComp
293 else
294 dst^ := -1;
295 Inc(xComp);
296 if xComp >= G.lx then
297 Dec(xComp, G.lx);
298 Inc(dst);
299 bit := bit shl 1;
300 end;
301 Inc(yComp, G.lx);
302 end
303 else
304 begin
305 for dx := 0 to 3 do
306 begin
307 dst^ := -$1000;
308 Inc(dst);
309 end;
310 end;
311end;
312
313function Distance(Loc0, Loc1: Integer): Integer;
314var
315 A, B, dx, dy: Integer;
316begin
317 Loc_to_ab(Loc0, Loc1, A, B);
318 dx := Abs(A - B);
319 dy := Abs(A + B);
320 Result := dx + dy + Abs(dx - dy) shr 1;
321end;
322
323procedure Init(NewGameData: TNewGameData);
324{$IFDEF DEBUG}var
325 Loc: Integer;
326{$ENDIF}
327begin
328 G := NewGameData;
329 MapSize := G.lx * G.ly;
330 decompose24 := (1 shl 24 - 1) div G.lx + 1;
331{$IFDEF DEBUG}
332 for Loc := 0 to MapSize - 1 do
333 Assert(Cardinal(Loc) * decompose24 shr 24 = Cardinal(Loc div G.lx));
334{$ENDIF}
335end;
336
337constructor TCustomAI.Create(Nation: Integer);
338begin
339 inherited Create;
340 Me := Nation;
341 RO := Pointer(G.RO[Nation]);
342 Map := Pointer(RO.Map);
343 MyUnit := Pointer(RO.Un);
344 MyCity := Pointer(RO.City);
345 MyModel := Pointer(RO.Model);
346 Opponent := -1;
347end;
348
349destructor TCustomAI.Destroy;
350begin
351 Server(sSetDebugMap, Me, 0, nodata^);
352end;
353
354procedure TCustomAI.Process(Command: Integer; var Data);
355var
356 Nation, NewResearch, NewGov, Count, ad, cix, iix: Integer;
357 NegoTime: TNegoTime;
358begin
359 case Command of
360 cTurn, cContinue:
361 begin
362 if RO.Alive and (1 shl Me) = 0 then
363 begin // I'm dead, huhu
364 Server(sTurn, Me, 0, nodata^);
365 Exit;
366 end;
367 if Command = cTurn then
368 begin
369 FillChar(cixStateImp, SizeOf(cixStateImp), $FF);
370 for cix := 0 to RO.nCity - 1 do
371 if MyCity[cix].Loc >= 0 then
372 for iix := imPalace to imSpacePort do
373 if MyCity[cix].Built[iix] > 0 then
374 cixStateImp[iix] := cix;
375 if RO.Happened and phChangeGov <> 0 then
376 begin
377 NewGov := ChooseGovernment;
378 if NewGov > gAnarchy then
379 Server(sSetGovernment, Me, NewGov, nodata^);
380 end;
381 HaveTurned := False;
382 Contacted := [];
383 end;
384 if (Command = cContinue) and (MyAction = scContact) then
385 begin
386 if OnNegoRejected_CancelTreaty then
387 if RO.Treaty[Opponent] >= trPeace then
388 if Server(sCancelTreaty, Me, 0, nodata^) < rExecuted then
389 Assert(False);
390 end
391 else
392 UnwantedNego := [];
393 Opponent := -1;
394 repeat
395 if HaveTurned then
396 NegoTime := EndOfTurn
397 else
398 NegoTime := BeginOfTurn;
399 if RO.Government <> gAnarchy then
400 for Nation := 0 to nPl - 1 do
401 if (Nation <> Me) and (1 shl Nation and RO.Alive <> 0) and
402 (RO.Treaty[Nation] >= trNone) and not (Nation in Contacted) and not
403 (Nation in UnwantedNego) and
404 (Server(scContact - sExecute + Nation shl 4, Me, 0, nodata^) >= rExecuted) then
405 if WantNegotiation(Nation, NegoTime) then
406 begin
407 if Server(scContact + Nation shl 4, Me, 0, nodata^) >= rExecuted then
408 begin
409 Include(Contacted, Nation);
410 Opponent := Nation;
411 MyAction := scContact;
412 Exit;
413 end;
414 end
415 else
416 Include(UnwantedNego, Nation);
417 if NegoTime = BeginOfTurn then
418 begin
419 DoTurn;
420 HaveTurned := True;
421 Contacted := [];
422 UnwantedNego := [];
423 end
424 else
425 Break;
426 until False;
427 if RO.Happened and phTech <> 0 then
428 begin
429 NewResearch := ChooseResearchAdvance;
430 if NewResearch < 0 then
431 begin // choose random research
432 Count := 0;
433 for ad := 0 to nAdv - 1 do
434 if AdvanceResearchable(ad) then
435 begin
436 Inc(Count);
437 if Random(Count) = 0 then
438 NewResearch := ad;
439 end;
440 end;
441 Server(sSetResearch, Me, NewResearch, nodata^);
442 end;
443 if Server(sTurn, Me, 0, nodata^) < rExecuted then
444 Assert(False);
445 end;
446 scContact:
447 if WantNegotiation(Integer(Data), EnemyCalled) then
448 begin
449 if Server(scDipStart, Me, 0, nodata^) < rExecuted then
450 Assert(False);
451 Opponent := Integer(Data);
452 MyAction := scDipStart;
453 end
454 else
455 begin
456 if Server(scReject, Me, 0, nodata^) < rExecuted then
457 Assert(False);
458 end;
459 scDipStart, scDipNotice, scDipAccept, scDipCancelTreaty, scDipOffer, scDipBreak:
460 begin
461 OppoAction := Command;
462 if Command = scDipOffer then
463 OppoOffer := TOffer(Data);
464 if Command = scDipStart then
465 MyLastAction := scContact
466 else
467 begin
468 MyLastAction := MyAction;
469 MyLastOffer := MyOffer;
470 end;
471 if (OppoAction = scDipCancelTreaty) or (OppoAction = scDipBreak) then
472 MyAction := scDipNotice
473 else
474 begin
475 MyAction := scDipOffer;
476 MyOffer.nDeliver := 0;
477 MyOffer.nCost := 0;
478 end;
479 DoNegotiation;
480 Assert((MyAction = scDipNotice) or (MyAction = scDipAccept) or
481 (MyAction = scDipCancelTreaty) or (MyAction = scDipOffer) or (MyAction = scDipBreak));
482 if MyAction = scDipOffer then
483 Server(MyAction, Me, 0, MyOffer)
484 else
485 Server(MyAction, Me, 0, nodata^);
486 end;
487 cShowEndContact:
488 Opponent := -1;
489 end;
490end;
491
492{$HINTS OFF}
493procedure TCustomAI.SetDataDefaults;
494begin
495end;
496
497procedure TCustomAI.SetDataRandom;
498begin
499end;
500
501procedure TCustomAI.DoTurn;
502begin
503end;
504
505procedure TCustomAI.DoNegotiation;
506begin
507end;
508
509procedure TCustomAI.OnBeforeEnemyAttack(UnitInfo: TUnitInfo;
510 ToLoc, EndHealth, EndHealthDef: Integer);
511begin
512end;
513
514procedure TCustomAI.OnBeforeEnemyCapture(UnitInfo: TUnitInfo; ToLoc: Integer);
515begin
516end;
517
518procedure TCustomAI.OnAfterEnemyAttack;
519begin
520end;
521
522procedure TCustomAI.OnAfterEnemyCapture;
523begin
524end;
525
526function TCustomAI.ChooseResearchAdvance: Integer;
527begin
528 Result := -1;
529end;
530
531function TCustomAI.ChooseStealAdvance: Integer;
532begin
533 Result := -1;
534end;
535
536function TCustomAI.ChooseGovernment: Integer;
537begin
538 Result := gDespotism;
539end;
540
541function TCustomAI.WantNegotiation(Nation: Integer; NegoTime: TNegoTime): Boolean;
542begin
543 Result := False;
544end;
545
546function TCustomAI.OnNegoRejected_CancelTreaty: Boolean;
547begin
548 Result := False;
549end;
550
551{$HINTS ON}
552
553procedure TCustomAI.StealAdvance;
554var
555 Steal, ad, Count: Integer;
556begin
557 Steal := ChooseStealAdvance;
558 if Steal < 0 then
559 begin // choose random advance
560 Count := 0;
561 for ad := 0 to nAdv - 1 do
562 if AdvanceStealable(ad) then
563 begin
564 Inc(Count);
565 if Random(Count) = 0 then
566 Steal := ad;
567 end;
568 end;
569 if Steal >= 0 then
570 Server(sStealTech, Me, Steal, nodata^);
571 RO.Happened := RO.Happened and not phStealTech;
572end;
573
574function TCustomAI.IsResearched(Advance: Integer): Boolean;
575begin
576 Result := (Advance = preNone) or (Advance <> preNA) and (RO.Tech[Advance] >= tsApplicable);
577end;
578
579function TCustomAI.ResearchCost: Integer;
580begin
581 Server(sGetTechCost, Me, 0, Result);
582end;
583
584function TCustomAI.ChangeAttitude(Nation, Attitude: Integer): Integer;
585begin
586 Result := Server(sSetAttitude + Nation shl 4, Me, Attitude, nodata^);
587end;
588
589function TCustomAI.Revolution: Integer;
590begin
591 Result := Server(sRevolution, Me, 0, nodata^);
592end;
593
594function TCustomAI.ChangeRates(Tax, Lux: Integer): Integer;
595begin
596 Result := Server(sSetRates, Me, Tax div 10 and $F + Lux div 10 and $F shl 4, nodata^);
597end;
598
599function TCustomAI.PrepareNewModel(Domain: Integer): Integer;
600begin
601 Result := Server(sCreateDevModel, Me, Domain, nodata^);
602end;
603
604function TCustomAI.SetNewModelFeature(F, Count: Integer): Integer;
605begin
606 Result := Server(sSetDevModelCap + Count shl 4, Me, F, nodata^);
607end;
608
609function TCustomAI.AdvanceResearchable(Advance: Integer): Boolean;
610begin
611 Result := Server(sSetResearch - sExecute, Me, Advance, nodata^) >= rExecuted;
612end;
613
614function TCustomAI.AdvanceStealable(Advance: Integer): Boolean;
615begin
616 Result := Server(sStealTech - sExecute, Me, Advance, nodata^) >= rExecuted;
617end;
618
619function TCustomAI.GetJobProgress(Loc: Integer;
620 var JobProgress: TJobProgressData): Boolean;
621begin
622 Result := Server(sGetJobProgress, Me, Loc, JobProgress) >= rExecuted;
623end;
624
625function TCustomAI.DebugMessage(Level: Integer; Text: string): Boolean;
626begin
627 Text := Copy('P' + Char(48 + Me) + ' ' + Text, 1, 254);
628 Server(sMessage, Me, Level, PChar(Text)^);
629
630 Result := True;
631 // always returns true so that it can be used like
632 // "Assert(DebugMessage(...));" -> not compiled in release build
633end;
634
635function TCustomAI.SetDebugMap(var DebugMap): Boolean;
636begin
637 Server(sSetDebugMap, Me, 0, DebugMap);
638
639 Result := True;
640 // always returns true so that it can be used like
641 // "Assert(SetDebugMap(...));" -> not compiled in release build
642end;
643
644procedure TCustomAI.Unit_FindMyDefender(Loc: Integer; var uix: Integer);
645begin
646 if Server(sGetDefender, Me, Loc, uix) < rExecuted then
647 uix := -1;
648end;
649
650procedure TCustomAI.Unit_FindEnemyDefender(Loc: Integer; var euix: Integer);
651begin
652 euix := RO.nEnemyUn - 1;
653 while (euix >= 0) and (RO.EnemyUn[euix].Loc <> Loc) do
654 Dec(euix);
655end;
656
657function TCustomAI.Unit_Move(uix, ToLoc: Integer): Integer;
658var
659 Step: Integer;
660 DestinationReached: Boolean;
661 Advice: TMoveAdviceData;
662begin
663 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0)); // is a unit
664{Loc_to_ab(MyUnit[uix].Loc,ToLoc,a,b);
665Assert((A<>0) or (B<>0));
666if (A>=-1) and (A<=1) and (B>=-1) and (B<=1) then
667 begin // move to adjacent tile
668 !!!problem: if Move is invalid, return codes are not consistent with other branch (eNoWay)
669 Advice.nStep:=1;
670 Advice.dx[0]:=A-B;
671 Advice.dy[0]:=A+B;
672 Advice.MoreTurns:=0;
673 Advice.MaxHostile_MovementLeft:=MyUnit[uix].Movement;
674 Result:=eOK;
675 end
676else}
677 begin // move to non-adjacent tile, find shortest path
678 Advice.ToLoc := ToLoc;
679 Advice.MoreTurns := 9999;
680 Advice.MaxHostile_MovementLeft := 100;
681 Result := Server(sGetMoveAdvice, Me, uix, Advice);
682 end;
683 if Result = eOk then
684 begin
685 DestinationReached := False;
686 Step := 0;
687 repeat
688 if Result and (rExecuted or rUnitRemoved) = rExecuted then
689 // check if destination reached
690 if (ToLoc >= 0) and (Advice.MoreTurns = 0) and (Step = Advice.nStep - 1) and
691 ((Map[ToLoc] and (fUnit or fOwned) = fUnit) // attack
692 or (Map[ToLoc] and (fCity or fOwned) = fCity) and
693 ((MyModel[MyUnit[uix].mix].Domain <> dGround) // bombardment
694 or (MyModel[MyUnit[uix].mix].Flags and mdCivil <> 0))) then // can't capture
695 begin
696 DestinationReached := True;
697 Break;
698 end // stop next to destination
699 else if Step = Advice.nStep then
700 DestinationReached := True; // normal move -- stop at destination
701
702 if (Step = Advice.nStep) or (Result <> eOK) and (Result <> eLoaded) then
703 Break;
704
705 Result := Server(sMoveUnit + (Advice.dx[Step] and 7) shl 4 +
706 (Advice.dy[Step] and 7) shl 7, Me, uix, nodata^);
707 Inc(Step);
708 if RO.Happened and phStealTech <> 0 then
709 StealAdvance;
710 until False;
711 if DestinationReached then
712 if Advice.nStep = 25 then
713 Result := Unit_Move(uix, ToLoc) // Shinkansen
714 else if Advice.MoreTurns = 0 then
715 Result := Result or rLocationReached
716 else
717 Result := Result or rMoreTurns;
718 end;
719end;
720
721function TCustomAI.Unit_Step(uix, ToLoc: Integer): Integer;
722var
723 A, B: Integer;
724begin
725 Loc_to_ab(MyUnit[uix].Loc, ToLoc, A, B);
726 Assert(((A <> 0) or (B <> 0)) and (A >= -1) and (A <= 1) and (B >= -1) and (B <= 1));
727 Result := Server(sMoveUnit + ((A - B) and 7) shl 4 + ((A + B) and 7) shl 7, Me, uix, nodata^);
728 if RO.Happened and phStealTech <> 0 then
729 StealAdvance;
730end;
731
732function TCustomAI.Unit_Attack(uix, ToLoc: Integer): Integer;
733var
734 A, B: Integer;
735begin
736 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit
737 and ((Map[ToLoc] and (fUnit or fOwned) = fUnit) // is an attack
738 or (Map[ToLoc] and (fCity or fOwned) = fCity) and
739 (MyModel[MyUnit[uix].mix].Domain <> dGround))); // is a bombardment
740 Loc_to_ab(MyUnit[uix].Loc, ToLoc, A, B);
741 Assert(((A <> 0) or (B <> 0)) and (A >= -1) and (A <= 1) and (B >= -1) and (B <= 1));
742 // attack to adjacent tile
743 Result := Server(sMoveUnit + (A - B) and 7 shl 4 + (A + B) and 7 shl 7, Me, uix, nodata^);
744end;
745
746function TCustomAI.Unit_DoMission(uix, MissionType, ToLoc: Integer): Integer;
747var
748 A, B: Integer;
749begin
750 Result := Server(sSetSpyMission + MissionType shl 4, Me, 0, nodata^);
751 if Result >= rExecuted then
752 begin
753 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit
754 and (MyModel[MyUnit[uix].mix].Kind = mkDiplomat)); // is a commando
755 Loc_to_ab(MyUnit[uix].Loc, ToLoc, A, B);
756 Assert(((A <> 0) or (B <> 0)) and (A >= -1) and (A <= 1) and (B >= -1) and (B <= 1));
757 // city must be adjacent
758 Result := Server(sMoveUnit - sExecute + (A - B) and 7 shl 4 + (A + B) and 7 shl 7, Me, uix, nodata^);
759 if Result = eMissionDone then
760 Result := Server(sMoveUnit + (A - B) and 7 shl 4 + (A + B) and 7 shl 7, Me, uix, nodata^)
761 else if (Result <> eNoTime_Move) and (Result <> eTreaty) and (Result <> eNoTurn) then
762 Result := eInvalid; // not a special commando mission!
763 end;
764end;
765
766function TCustomAI.Unit_MoveForecast(uix, ToLoc: Integer;
767 var RemainingMovement: Integer): Boolean;
768var
769 Advice: TMoveAdviceData;
770begin
771 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0)); // is a unit
772 Advice.ToLoc := ToLoc;
773 Advice.MoreTurns := 0;
774 Advice.MaxHostile_MovementLeft := 100;
775 if Server(sGetMoveAdvice, Me, uix, Advice) = eOk then
776 begin
777 RemainingMovement := Advice.MaxHostile_MovementLeft;
778 Result := True;
779 end
780 else
781 begin
782 RemainingMovement := -1;
783 Result := False;
784 end;
785end;
786
787// negative RemainingHealth is remaining helth of defender if lost
788function TCustomAI.Unit_AttackForecast(uix, ToLoc, AttackMovement: Integer;
789 var RemainingHealth: Integer): Boolean;
790var
791 BattleForecast: TBattleForecast;
792begin
793 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit
794 and (Map[ToLoc] and (fUnit or fOwned) = fUnit)); // is an attack
795 RemainingHealth := -$100;
796 Result := False;
797 if AttackMovement >= 0 then
798 with MyUnit[uix] do
799 begin
800 BattleForecast.pAtt := Me;
801 BattleForecast.mixAtt := mix;
802 BattleForecast.HealthAtt := Health;
803 BattleForecast.ExpAtt := Exp;
804 BattleForecast.FlagsAtt := Flags;
805 BattleForecast.Movement := AttackMovement;
806 if Server(sGetBattleForecast, Me, ToLoc, BattleForecast) >= rExecuted then
807 begin
808 if BattleForecast.EndHealthAtt > 0 then
809 RemainingHealth := BattleForecast.EndHealthAtt
810 else
811 RemainingHealth := -BattleForecast.EndHealthDef;
812 Result := True;
813 end;
814 end;
815end;
816
817function TCustomAI.Unit_DefenseForecast(euix, ToLoc: Integer;
818 var RemainingHealth: Integer): Boolean;
819var
820 BattleForecast: TBattleForecast;
821begin
822 Assert((euix >= 0) and (euix < RO.nEnemyUn) and (RO.EnemyUn[euix].Loc >= 0) // is an enemy unit
823 and (Map[ToLoc] and (fUnit or fOwned) = (fUnit or fOwned))); // is an attack
824 RemainingHealth := $100;
825 Result := False;
826 with RO.EnemyUn[euix] do
827 begin
828 BattleForecast.pAtt := Owner;
829 BattleForecast.mixAtt := mix;
830 BattleForecast.HealthAtt := Health;
831 BattleForecast.ExpAtt := Exp;
832 BattleForecast.FlagsAtt := Flags;
833 BattleForecast.Movement := 100;
834 if Server(sGetBattleForecast, Me, ToLoc, BattleForecast) >= rExecuted then
835 begin
836 if BattleForecast.EndHealthDef > 0 then
837 RemainingHealth := BattleForecast.EndHealthDef
838 else
839 RemainingHealth := -BattleForecast.EndHealthAtt;
840 Result := True;
841 end;
842 end;
843end;
844
845function TCustomAI.Unit_Disband(uix: Integer): Integer;
846begin
847 Result := Server(sRemoveUnit, Me, uix, nodata^);
848end;
849
850function TCustomAI.Unit_StartJob(uix, NewJob: Integer): Integer;
851begin
852 Result := Server(sStartJob + NewJob shl 4, Me, uix, nodata^);
853end;
854
855function TCustomAI.Unit_SetHomeHere(uix: Integer): Integer;
856begin
857 Result := Server(sSetUnitHome, Me, uix, nodata^);
858end;
859
860function TCustomAI.Unit_Load(uix: Integer): Integer;
861begin
862 Result := Server(sLoadUnit, Me, uix, nodata^);
863end;
864
865function TCustomAI.Unit_Unload(uix: Integer): Integer;
866begin
867 Result := Server(sUnloadUnit, Me, uix, nodata^);
868end;
869
870function TCustomAI.Unit_AddToCity(uix: Integer): Integer;
871begin
872 Result := Server(sAddToCity, Me, uix, nodata^);
873end;
874
875function TCustomAI.Unit_SelectTransport(uix: Integer): Integer;
876begin
877 Result := Server(sSelectTransport, Me, uix, nodata^);
878end;
879
880
881procedure TCustomAI.City_FindMyCity(Loc: Integer; var cix: Integer);
882begin
883 if Map[Loc] and (fCity or fOwned) <> fCity or fOwned then
884 cix := -1
885 else
886 begin
887 cix := RO.nCity - 1;
888 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do
889 Dec(cix);
890 end;
891end;
892
893procedure TCustomAI.City_FindEnemyCity(Loc: Integer; var ecix: Integer);
894begin
895 if Map[Loc] and (fCity or fOwned) <> fCity then
896 ecix := -1
897 else
898 begin
899 ecix := RO.nEnemyCity - 1;
900 while (ecix >= 0) and (RO.EnemyCity[ecix].Loc <> Loc) do
901 Dec(ecix);
902 end;
903end;
904
905function TCustomAI.City_HasProject(cix: Integer): Boolean;
906begin
907 Result := MyCity[cix].Project and (cpImp + cpIndex) <> cpImp + imTrGoods;
908end;
909
910function TCustomAI.City_CurrentImprovementProject(cix: Integer): Integer;
911begin
912 if MyCity[cix].Project and cpImp = 0 then
913 Result := -1
914 else
915 begin
916 Result := MyCity[cix].Project and cpIndex;
917 if Result = imTrGoods then
918 Result := -1;
919 end;
920end;
921
922function TCustomAI.City_CurrentUnitProject(cix: Integer): Integer;
923begin
924 if MyCity[cix].Project and cpImp <> 0 then
925 Result := -1
926 else
927 Result := MyCity[cix].Project and cpIndex;
928end;
929
930function TCustomAI.City_GetTileInfo(cix, TileLoc: Integer;
931 var TileInfo: TTileInfo): Integer;
932begin
933 TileInfo.ExplCity := cix;
934 Result := Server(sGetHypoCityTileInfo, Me, TileLoc, TileInfo);
935end;
936
937function TCustomAI.City_GetReport(cix: Integer; var Report: TCityReport): Integer;
938begin
939 Report.HypoTiles := -1;
940 Report.HypoTax := -1;
941 Report.HypoLux := -1;
942 Result := Server(sGetCityReport, Me, cix, Report);
943end;
944
945function TCustomAI.City_GetHypoReport(cix, HypoTiles, HypoTax, HypoLux: Integer;
946 var Report: TCityReport): Integer;
947begin
948 Report.HypoTiles := HypoTiles;
949 Report.HypoTax := HypoTax;
950 Report.HypoLux := HypoLux;
951 Result := Server(sGetCityReport, Me, cix, Report);
952end;
953
954function TCustomAI.City_GetReportNew(cix: Integer; var Report: TCityReportNew): Integer;
955begin
956 Report.HypoTiles := -1;
957 Report.HypoTaxRate := -1;
958 Report.HypoLuxuryRate := -1;
959 Result := Server(sGetCityReportNew, Me, cix, Report);
960end;
961
962function TCustomAI.City_GetHypoReportNew(cix, HypoTiles, HypoTaxRate,
963 HypoLuxuryRate: Integer; var Report: TCityReportNew): Integer;
964begin
965 Report.HypoTiles := HypoTiles;
966 Report.HypoTaxRate := HypoTaxRate;
967 Report.HypoLuxuryRate := HypoLuxuryRate;
968 Result := Server(sGetCityReportNew, Me, cix, Report);
969end;
970
971function TCustomAI.City_GetAreaInfo(cix: Integer; var AreaInfo: TCityAreaInfo): Integer;
972begin
973 Result := Server(sGetCityAreaInfo, Me, cix, AreaInfo);
974end;
975
976function TCustomAI.City_StartUnitProduction(cix, mix: Integer): Integer;
977begin
978 if (MyCity[cix].Project and (cpImp + cpIndex) <> mix) then
979 // not already producing that
980 Result := Server(sSetCityProject, Me, cix, mix);
981end;
982
983function TCustomAI.City_StartEmigration(cix, mix: Integer;
984 AllowDisbandCity, AsConscripts: Boolean): Integer;
985var
986 NewProject: Integer;
987begin
988 NewProject := mix;
989 if AllowDisbandCity then
990 NewProject := NewProject or cpDisbandCity;
991 if AsConscripts then
992 NewProject := NewProject or cpConscripts;
993 Result := Server(sSetCityProject, Me, cix, NewProject);
994end;
995
996function TCustomAI.City_StartImprovement(cix, iix: Integer): Integer;
997var
998 NewProject: Integer;
999begin
1000 NewProject := iix + cpImp;
1001 if (MyCity[cix].Project and (cpImp + cpIndex) <> NewProject) then
1002 // not already producing that
1003 Result := Server(sSetCityProject, Me, cix, NewProject);
1004end;
1005
1006function TCustomAI.City_Improvable(cix, iix: Integer): Boolean;
1007var
1008 NewProject: Integer;
1009begin
1010 NewProject := iix + cpImp;
1011 Result := Server(sSetCityProject - sExecute, Me, cix, NewProject) >= rExecuted;
1012end;
1013
1014function TCustomAI.City_StopProduction(cix: Integer): Integer;
1015var
1016 NewProject: Integer;
1017begin
1018 NewProject := imTrGoods + cpImp;
1019 Result := Server(sSetCityProject, Me, cix, NewProject);
1020end;
1021
1022function TCustomAI.City_BuyProject(cix: Integer): Integer;
1023begin
1024 Result := Server(sBuyCityProject, Me, cix, nodata^);
1025end;
1026
1027function TCustomAI.City_SellImprovement(cix, iix: Integer): Integer;
1028begin
1029 Result := Server(sSellCityImprovement, Me, cix, iix);
1030end;
1031
1032function TCustomAI.City_RebuildImprovement(cix, iix: Integer): Integer;
1033begin
1034 Result := Server(sRebuildCityImprovement, Me, cix, iix);
1035end;
1036
1037function TCustomAI.City_SetTiles(cix, NewTiles: Integer): Integer;
1038begin
1039 Result := Server(sSetCityTiles, Me, cix, NewTiles);
1040end;
1041
1042procedure TCustomAI.City_OptimizeTiles(cix: Integer; ResourceWeights: Cardinal);
1043var
1044 Advice: TCityTileAdviceData;
1045begin
1046 Advice.ResourceWeights := ResourceWeights;
1047 Server(sGetCityTileAdvice, Me, cix, Advice);
1048 City_SetTiles(cix, Advice.Tiles);
1049end;
1050
1051// negotiation
1052function TCustomAI.Nego_CheckMyAction: Integer;
1053begin
1054 Assert(Opponent >= 0); // only allowed in negotiation mode
1055 Assert((MyAction = scDipNotice) or (MyAction = scDipAccept) or
1056 (MyAction = scDipCancelTreaty) or (MyAction = scDipOffer) or (MyAction = scDipBreak));
1057 if MyAction = scDipOffer then
1058 Result := Server(MyAction - sExecute, Me, 0, MyOffer)
1059 else
1060 Result := Server(MyAction - sExecute, Me, 0, nodata^);
1061end;
1062
1063initialization
1064 nodata := Pointer(0);
1065 RWDataSize := 0;
1066
1067end.
Note: See TracBrowser for help on using the repository browser.