source: trunk/AI Template/CustomAI.pas

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