source: branches/delphi/AI/CustomAI.pas

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