source: trunk/AI/StdAI/CustomAI_Reload.pas

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