source: branches/highdpi/GameServer.pas@ 178

Last change on this file since 178 was 178, checked in by chronos, 2 years ago
  • Modified: Use DpiControls package for High DPI support.
File size: 154.4 KB
Line 
1{$INCLUDE Switches.inc}
2// {$DEFINE TEXTLOG}
3// {$DEFINE LOADPERF}
4unit GameServer;
5
6interface
7
8uses
9 Protocol, Database, dynlibs, Platform, dateutils, fgl, FileUtil, Graphics,
10 UDpiControls;
11
12const
13 Version = $010200;
14 FirstAICompatibleVersion = $000D00;
15 FirstBookCompatibleVersion = $010103;
16
17 // notifications
18 ntCreateWorld = 0;
19 ntInitModule = $100;
20 ntInitLocalHuman = $1FF;
21 ntDLLError = $200;
22 ntAIError = $2FF;
23 ntClientError = $300;
24 ntInitPlayers = $400;
25 ntDeactivationMissing = $410;
26 ntSetAIName = $420;
27 ntException = $500;
28 ntLoadBegin = $600;
29 ntLoadState = $601;
30 ntEndInfo = $6FC;
31 ntBackOn = $6FD;
32 ntBackOff = $6FE;
33 ntLoadError = $6FF;
34 ntStartDone = $700;
35 ntStartGo = $701;
36 ntStartGoRefresh = $702;
37 ntStartGoRefreshMaps = $703;
38 ntChangeClient = $800;
39 ntNextPlayer = $810;
40 ntDeinitModule = $900;
41
42 // module flags
43 fMultiple = $10000000;
44 fDotNet = $20000000;
45 fUsed = $40000000;
46
47 // save map tile flags
48 smOwned = $20;
49 smUnit = $40;
50 smCity = $80;
51
52 maxBrain = 255;
53
54type
55 TNotifyFunction = procedure(ID: integer);
56
57 TBrainType = (btNoTerm, btSuperVirtual, btTerm, btRandom, btAI);
58
59 { TBrain }
60
61 TBrain = class
62 FileName: string;
63 DLLName: string;
64 Name: string;
65 Credits: string; { filename and full name }
66 hm: TLibHandle; { module handle }
67 Flags: Integer;
68 ServerVersion: Integer;
69 DataVersion: Integer;
70 DataSize: Integer;
71 Client: TClientCall; { client function address }
72 Initialized: Boolean;
73 Kind: TBrainType;
74 Picture: TDpiBitmap;
75 procedure LoadFromFile(AIFileName: string);
76 constructor Create;
77 destructor Destroy; override;
78 end;
79
80 { TBrains }
81
82 TBrains = class(TFPGObjectList<TBrain>)
83 function AddNew: TBrain;
84 function GetKindCount(Kind: TBrainType): Integer;
85 procedure GetByKind(Kind: TBrainType; Brains: TBrains);
86 end;
87
88var
89 // PARAMETERS
90 PlayersBrain: TBrains; { brain of the players }
91 Difficulty: array [0 .. nPl - 1] of integer absolute Database.Difficulty;
92 { difficulty }
93
94 // READ ONLY
95 DotNetClient: TClientCall;
96 Brains: TBrains; // { available brains }
97 NotifyMessage: string;
98
99 BrainNoTerm: TBrain;
100 BrainSuperVirtual: TBrain;
101 BrainTerm: TBrain;
102 BrainRandom: TBrain;
103 BrainBeginner: TBrain; // AI to use for beginner level
104
105procedure Init(NotifyFunction: TNotifyFunction);
106procedure Done;
107
108procedure StartNewGame(const Path, FileName, Map: string;
109 Newlx, Newly, NewLandMass, NewMaxTurn: integer);
110function LoadGame(const Path, FileName: string; Turn: integer;
111 MovieMode: boolean): boolean;
112procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: integer);
113procedure DirectHelp(Command: integer);
114
115procedure ChangeClient;
116procedure NextPlayer;
117function PreviewMap(lm: integer): pointer;
118
119implementation
120
121uses
122 Directories, CityProcessing, UnitProcessing, CmdList,
123
124 LCLIntf, LCLType, LMessages, Classes, SysUtils;
125
126var
127 MaxTurn: Integer;
128 LoadTurn: Integer; { turn where to stop loading }
129 nLogOpened: Integer; { nLog of opened book }
130{$IFOPT O-}nHandoverStack, {$ENDIF}
131 LastEndClientCommand: Integer;
132 pContacted: Integer; // player contacted for negotiation
133 pDipActive: Integer; // player who's to speak in a negotiation
134 pTurn: Integer; { player who's turn it is }
135 GWinner: Integer;
136 GColdWarStart: Integer;
137 GStealFrom: Integer;
138 SpyMission: Integer;
139 ZOCTile: Integer;
140 CCCommand: Integer;
141 CCPlayer: Integer;
142 DebugMap: array [0 .. nPl - 1] of Pointer;
143 ExeInfo: TSearchRec;
144 Stat: array [0 .. nStat - 1, 0 .. nPl - 1] of ^TChart;
145 AutoSaveState: TCmdListState;
146 MapField: ^Cardinal; // predefined map
147 LastOffer: TOffer;
148 CCData: array [0 .. 14] of integer;
149 bix: TBrains; { brain of the players }
150 DevModelTurn, { turn of last call to sResetModel }
151 OriginalDataVersion: array [0 .. nPl - 1] of integer;
152 SavedTiles { , SavedResourceWeights } : array [0 .. ncmax - 1] of Cardinal;
153 SavedData: array [0 .. nPl - 1] of pointer;
154 LogFileName: string;
155 SavePath: string; { name of file for saving the current game }
156 MapFileName: string; // name of map to use, empty for random
157 AICredits: string;
158 AIInfo: array [0 .. nPl - 1] of string;
159 Notify: TNotifyFunction;
160 LastClientTime: TDateTime;
161{$IFOPT O-}HandoverStack: array [0 .. 31] of Cardinal; {$ENDIF}
162 AutoSaveExists: Boolean;
163 LoadOK: Boolean;
164 WinOnAlone: Boolean;
165 PreviewElevation: Boolean;
166 MovieStopped: Boolean;
167
168const
169 PreviewRND = 41601260; { randseed for preview map }
170
171function Server(Command, Player, Subject: integer; var Data): integer;
172 stdcall; forward;
173
174procedure CallPlayer(Command, p: integer; var Data);
175begin
176 if ((Mode <> moMovie) or (p = 0)) then
177 begin
178{$IFOPT O-}
179 HandoverStack[nHandoverStack] := p;
180 HandoverStack[nHandoverStack + 1] := Command;
181 inc(nHandoverStack, 2);
182 bix[p].Client(Command, p, Data);
183 dec(nHandoverStack, 2);
184{$ELSE}
185 try
186 Brain[bix[p]].Client(Command, p, Data);
187 except
188 Notify(ntException + bix[p]);
189 end;
190{$ENDIF}
191 end
192end;
193
194procedure CallClient(bix, Command: integer; var Data);
195begin
196 if ((Mode <> moMovie) or (bix = Brains.IndexOf(GameServer.bix[0]))) then
197 begin
198{$IFOPT O-}
199 HandoverStack[nHandoverStack] := bix;
200 HandoverStack[nHandoverStack + 1] := Command;
201 inc(nHandoverStack, 2);
202 Brains[bix].Client(Command, -1, Data);
203 dec(nHandoverStack, 2);
204{$ELSE}
205 try
206 Brain[bix].Client(Command, -1, Data);
207 except
208 Notify(ntException + bix);
209 end;
210{$ENDIF}
211 end
212end;
213
214procedure Init(NotifyFunction: TNotifyFunction);
215var
216 f: TSearchRec;
217 BasePath: string;
218 NewBrain: TBrain;
219 I: Integer;
220begin
221 Notify := NotifyFunction;
222 PreviewElevation := false;
223 PlayersBrain := TBrains.Create(False);
224 PlayersBrain.Count := nPl;
225 for I := 0 to nPl - 1 do
226 PlayersBrain[I] := nil;
227
228 bix := TBrains.Create(False);
229 bix.Count := nPl;
230 for I := 0 to nPl - 1 do
231 bix[I] := nil;
232
233 { get available brains }
234 Brains := TBrains.Create;
235 BrainNoTerm := Brains.AddNew;
236 BrainNoTerm.FileName := ':AIT';
237 BrainNoTerm.Flags := 0;
238 BrainNoTerm.Initialized := false;
239 BrainNoTerm.Kind := btNoTerm;
240 BrainSuperVirtual := Brains.AddNew;
241 BrainSuperVirtual.FileName := ':Supervisor';
242 BrainSuperVirtual.Flags := 0;
243 BrainSuperVirtual.Initialized := false;
244 BrainSuperVirtual.Kind := btSuperVirtual;
245 BrainTerm := Brains.AddNew;
246 BrainTerm.FileName := ':StdIntf';
247 BrainTerm.Flags := fMultiple;
248 BrainTerm.Initialized := false;
249 BrainTerm.ServerVersion := Version;
250 BrainTerm.Kind := btTerm;
251 BrainRandom := Brains.AddNew;
252 BrainRandom.FileName := ':Random';
253 BrainRandom.Flags := fMultiple;
254 BrainRandom.Initialized := false;
255 BrainRandom.Kind := btRandom;
256
257 BrainBeginner := nil;
258
259 if FindFirst(HomeDir + 'AI' + DirectorySeparator + '*', faDirectory or faArchive or faReadOnly, f) = 0 then
260 repeat
261 BasePath := HomeDir + 'AI' + DirectorySeparator + f.Name;
262 if (f.Name <> '.') and (f.Name <> '..') and DirectoryExists(BasePath) then begin
263 NewBrain := Brains.AddNew;
264 NewBrain.Kind := btAI;
265 NewBrain.LoadFromFile(BasePath + DirectorySeparator + F.Name + '.ai.txt');
266 if (NewBrain.ServerVersion >= FirstAICompatibleVersion) and
267 (NewBrain.ServerVersion <= Version) and
268 ((NewBrain.Flags and fDotNet = 0) or (@DotNetClient <> nil)) then begin
269 end else Brains.Delete(Brains.Count - 1);
270 end;
271 until FindNext(f) <> 0;
272 FindClose(F);
273
274 if Brains.GetKindCount(btAI) = 0 then
275 raise Exception.Create(Format('No AI libraries found in directory %s', [HomeDir + 'AI']));
276end;
277
278procedure Done;
279var
280 I: Integer;
281begin
282 for I := 0 to Brains.Count - 1 do
283 with Brains[I] do
284 if Initialized then begin
285 CallClient(I, cReleaseModule, nil^);
286 if (Kind = btAI) and ((Flags and fDotNet) = 0) then
287 FreeLibrary(hm);
288 end;
289 PlayersBrain.Free;
290 bix.Free;
291 Brains.Free;
292end;
293
294function PreviewMap(lm: integer): pointer;
295begin
296 lx := lxmax;
297 ly := lymax;
298 MapSize := lx * ly;
299 LandMass := lm;
300 DelphiRandSeed := PreviewRND;
301 if not PreviewElevation then
302 begin
303 CreateElevation;
304 PreviewElevation := true;
305 end;
306 CreateMap(true);
307 result := @RealMap;
308end;
309
310procedure ChangeClientWhenDone(Command, Player: integer; var Data;
311 DataSize: integer);
312begin
313 CCCommand := Command;
314 CCPlayer := Player;
315 if DataSize > 0 then
316 move(Data, CCData, DataSize);
317 Notify(ntChangeClient);
318end;
319
320procedure PutMessage(Level: integer; Text: string);
321begin
322 bix[0].Client(cDebugMessage, Level, pchar(Text)^);
323end;
324
325procedure ForceClientDeactivation;
326var
327 NullOffer: TOffer;
328begin
329 if pDipActive < 0 then
330 Server(sTurn, pTurn, 0, nil^) // no nego mode
331 else
332 case LastEndClientCommand of // nego mode
333 scContact:
334 Server(scReject, pDipActive, 0, nil^);
335 scDipCancelTreaty, scDipBreak:
336 Server(scDipNotice, pDipActive, 0, nil^);
337 else
338 begin // make null offer
339 NullOffer.nDeliver := 0;
340 NullOffer.nCost := 0;
341 Server(scDipOffer, pDipActive, 0, NullOffer);
342 end
343 end
344end;
345
346procedure ChangeClient;
347// hand over control to other client (as specified by CC...)
348var
349 p: integer;
350 T: TDateTime;
351begin
352 T := NowPrecise;
353 PutMessage(1 shl 16 + 2, Format('CLIENT: took %.1f ms',
354 [(T - LastClientTime) / OneMillisecond]));
355 LastClientTime := T;
356 PutMessage(1 shl 16 + 2, Format('CLIENT: calling %d (%s)',
357 [CCPlayer, bix[CCPlayer].Name]));
358 if CCCommand = cTurn then
359 for p := 0 to nPl - 1 do
360 if (p <> CCPlayer) and (1 shl p and GWatching <> 0) then
361 CallPlayer(cShowTurnChange, p, CCPlayer);
362
363 p := CCPlayer;
364 CCPlayer := -1;
365 CallPlayer(CCCommand, p, CCData);
366 if (Mode = moPlaying) and (bix[p].Flags and aiThreaded = 0) and
367 (CCPlayer < 0) then
368 begin
369 Notify(ntDeactivationMissing + p);
370 ForceClientDeactivation;
371 end
372end;
373
374procedure Inform(p: integer);
375var
376 i, p1: integer;
377begin
378 RW[p].Turn := GTurn;
379 if (GTurn = MaxTurn) and (p = pTurn) and (p = 0) then
380 RW[p].Happened := RW[p].Happened or phTimeUp;
381 if (GWinner > 0) and (p = pTurn) and (p = 0) then
382 RW[p].Happened := RW[p].Happened or phShipComplete;
383 RW[p].Alive := GAlive;
384 move(GWonder, RW[p].Wonder, SizeOf(GWonder));
385 move(GShip, RW[p].Ship, SizeOf(GShip));
386 for p1 := 0 to nPl - 1 do
387 if (p1 <> p) and Assigned(bix[p1]) and (Difficulty[p1] > 0) then
388 RW[p].EnemyReport[p1].Credibility := RW[p1].Credibility;
389 for p1 := 0 to nPl - 1 do
390 if (p1 <> p) and (1 shl p1 and GAlive <> 0) then
391 begin
392 if (GTestFlags and tfUncover <> 0) or (Difficulty[p] = 0) or
393 (RW[p].Treaty[p1] >= trFriendlyContact) then
394 GiveCivilReport(p, p1);
395 if (GTestFlags and tfUncover <> 0) or (Difficulty[p] = 0) or
396 (RW[p].Treaty[p1] = trAlliance) then
397 GiveMilReport(p, p1)
398 end;
399 for i := 0 to RW[p].nEnemyModel - 1 do
400 with RW[p].EnemyModel[i] do
401 Lost := Destroyed[p, Owner, mix];
402end;
403
404procedure LogChanges;
405var
406 p, ix: integer;
407begin
408 for p := 0 to nPl - 1 do
409 if (1 shl p and GWatching <> 0) and ProcessClientData[p] then
410 begin
411 // log unit status changes
412 for ix := 0 to RW[p].nUn - 1 do
413 with RW[p].Un[ix] do
414 if (Loc >= 0) and (SavedStatus <> Status) then
415 begin
416 CL.Put(sIntSetUnitStatus, p, ix, @Status);
417 SavedStatus := Status
418 end;
419 // log city status changes
420 for ix := 0 to RW[p].nCity - 1 do
421 with RW[p].City[ix] do
422 if (Loc >= 0) and (SavedStatus <> Status) then
423 begin
424 CL.Put(sIntSetCityStatus, p, ix, @Status);
425 SavedStatus := Status
426 end;
427 // log model status changes
428 for ix := 0 to RW[p].nModel - 1 do
429 with RW[p].Model[ix] do
430 if SavedStatus <> Status then
431 begin
432 CL.Put(sIntSetModelStatus, p, ix, @Status);
433 SavedStatus := Status
434 end;
435 // log enemy city status changes
436 for ix := 0 to RW[p].nEnemyCity - 1 do
437 with RW[p].EnemyCity[ix] do
438 if (Loc >= 0) and (SavedStatus <> Status) then
439 begin
440 CL.Put(sIntSetECityStatus, p, ix, @Status);
441 SavedStatus := Status
442 end;
443 // log data changes
444 if bix[p].DataSize > 0 then
445 begin
446 CL.PutDataChanges(sIntDataChange, p, SavedData[p], RW[p].Data,
447 bix[p].DataSize);
448 move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
449 end
450 end;
451end;
452
453procedure NoLogChanges;
454var
455 p, ix: integer;
456begin
457 for p := 0 to nPl - 1 do
458 if (1 shl p and GWatching <> 0) and ProcessClientData[p] then
459 begin
460 for ix := 0 to RW[p].nUn - 1 do
461 with RW[p].Un[ix] do
462 SavedStatus := Status;
463 for ix := 0 to RW[p].nCity - 1 do
464 with RW[p].City[ix] do
465 SavedStatus := Status;
466 for ix := 0 to RW[p].nModel - 1 do
467 with RW[p].Model[ix] do
468 SavedStatus := Status;
469 for ix := 0 to RW[p].nEnemyCity - 1 do
470 with RW[p].EnemyCity[ix] do
471 SavedStatus := Status;
472 if bix[p].DataSize > 0 then
473 move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
474 end;
475end;
476
477function HasChanges(p: integer): boolean;
478type
479 TDWordList = array [0 .. INFIN] of Cardinal;
480 PDWortList = ^TDWordList;
481var
482 ix: integer;
483begin
484 result := false;
485 for ix := 0 to RW[p].nUn - 1 do
486 with RW[p].Un[ix] do
487 if (Loc >= 0) and (SavedStatus <> Status) then
488 result := true;
489 for ix := 0 to RW[p].nCity - 1 do
490 with RW[p].City[ix] do
491 if (Loc >= 0) and (SavedStatus <> Status) then
492 result := true;
493 for ix := 0 to RW[p].nModel - 1 do
494 with RW[p].Model[ix] do
495 if SavedStatus <> Status then
496 result := true;
497 for ix := 0 to RW[p].nEnemyCity - 1 do
498 with RW[p].EnemyCity[ix] do
499 if (Loc >= 0) and (SavedStatus <> Status) then
500 result := true;
501 if RW[p].Data <> nil then
502 for ix := 0 to bix[p].DataSize - 1 do
503 if PDWortList(SavedData[p])[ix] <> PDWortList(RW[p].Data)[ix] then
504 result := true
505end;
506
507procedure InitBrain(bix: TBrain);
508var
509 InitModuleData: TInitModuleData;
510begin
511 assert(bix.Kind <> btSuperVirtual);
512 with bix do begin
513 if Initialized then
514 exit;
515 if Kind = btAI then
516 begin { get client function }
517 Notify(ntInitModule + Brains.IndexOf(bix));
518 if Flags and fDotNet > 0 then
519 Client := DotNetClient
520 else
521 begin
522 hm := LoadLibrary(pchar(DLLName));
523 if hm = 0 then
524 begin
525 Client := nil;
526 Notify(ntDLLError + Brains.IndexOf(bix));
527 end
528 else
529 begin
530 Client := GetProcAddress(hm, 'client');
531 if @Client = nil then
532 Notify(ntClientError + Brains.IndexOf(bix));
533 end
534 end
535 end;
536 if @Client <> nil then
537 begin
538 Initialized := true;
539 InitModuleData.Server := @Server;
540 InitModuleData.DataVersion := 0;
541 InitModuleData.DataSize := 0;
542 InitModuleData.Flags := 0;
543 CallClient(Brains.IndexOf(bix), cInitModule, InitModuleData);
544 DataVersion := InitModuleData.DataVersion;
545 DataSize := (InitModuleData.DataSize + 3) div 4;
546 if DataSize > MaxDataSize then
547 DataSize := 0;
548 Flags := Flags or InitModuleData.Flags;
549 end
550 end
551end;
552
553procedure SaveMap(FileName: string);
554var
555 i: integer;
556 MapFile: TFileStream;
557 s: string[255];
558begin
559 MapFile := TFileStream.Create(DataDir + 'Maps' + DirectorySeparator + FileName,
560 fmCreate or fmShareExclusive);
561 MapFile.Position := 0;
562 s := 'cEvoMap'#0;
563 MapFile.write(s[1], 8); { file id }
564 i := 0;
565 MapFile.write(i, 4); { format id }
566 MapFile.write(MaxTurn, 4);
567 MapFile.write(lx, 4);
568 MapFile.write(ly, 4);
569 MapFile.write(RealMap, MapSize * 4);
570 MapFile.Free;
571end;
572
573function LoadMap(FileName: string): boolean;
574var
575 i, Loc1: integer;
576 MapFile: TFileStream;
577 s: string[255];
578begin
579 result := false;
580 MapFile := nil;
581 try
582 MapFile := TFileStream.Create(DataDir + 'Maps' + DirectorySeparator + FileName,
583 fmOpenRead or fmShareExclusive);
584 MapFile.Position := 0;
585 MapFile.read(s[1], 8); { file id }
586 MapFile.read(i, 4); { format id }
587 if i = 0 then
588 begin
589 MapFile.read(i, 4); // MaxTurn
590 MapFile.read(lx, 4);
591 MapFile.read(ly, 4);
592 ly := ly and not 1;
593 if lx > lxmax then
594 lx := lxmax;
595 if ly > lymax then
596 ly := lymax;
597 MapSize := lx * ly;
598 MapFile.read(RealMap, MapSize * 4);
599 for Loc1 := 0 to MapSize - 1 do
600 begin
601 RealMap[Loc1] := RealMap[Loc1] and
602 ($7F01FFFF or fPrefStartPos or fStartPos) or ($F shl 27);
603 if RealMap[Loc1] and (fTerrain or fSpecial) = fSwamp or fSpecial2 then
604 RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial) or
605 (fSwamp or fSpecial1);
606 if (RealMap[Loc1] and fDeadLands <> 0) and
607 (RealMap[Loc1] and fTerrain <> fArctic) then
608 RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial)
609 or fDesert;
610 end;
611 result := true;
612 end;
613 MapFile.Free;
614 except
615 if MapFile <> nil then
616 MapFile.Free;
617 end;
618end;
619
620procedure SaveGame(FileName: string; auto: boolean);
621var
622 x, y, i, zero, Tile, nLocal: integer;
623 LogFile: TFileStream;
624 s: string[255];
625 SaveMap: array [0 .. lxmax * lymax - 1] of Byte;
626begin
627 nLocal := 0;
628 for i := 0 to nPl - 1 do
629 if Assigned(bix[i]) and (bix[i].Kind = btTerm) then
630 inc(nLocal);
631 if Difficulty[0] = 0 then
632 nLocal := 0;
633 if nLocal <= 1 then
634 for y := 0 to ly - 1 do
635 for x := 0 to lx - 1 do
636 begin
637 Tile := RW[0].Map[(x + SaveMapCenterLoc + lx shr 1) mod lx + lx * y];
638 SaveMap[x + lx * y] := Tile and fTerrain + Tile and
639 (fCity or fUnit or fOwned) shr 16;
640 end;
641
642 if auto and AutoSaveExists then // append to existing file
643 LogFile := TFileStream.Create(SavePath + FileName, fmOpenReadWrite or
644 fmShareExclusive)
645 else // create new file
646 LogFile := TFileStream.Create(SavePath + FileName,
647 fmCreate or fmShareExclusive);
648
649 zero := 0;
650 LogFile.Position := 0;
651 s := 'cEvoBook';
652 LogFile.write(s[1], 8); { file id }
653 i := Version;
654 LogFile.write(i, 4); { c-evo version }
655 LogFile.write(ExeInfo.Time, 4);
656 LogFile.write(lx, 4);
657 LogFile.write(ly, 4);
658 LogFile.write(LandMass, 4);
659 if LandMass = 0 then
660 LogFile.write(MapField^, MapSize * 4);
661
662 LogFile.write(MaxTurn, 4);
663 LogFile.write(RND, 4);
664 LogFile.write(GTurn, 4);
665 if nLocal > 1 then // multiplayer game -- no quick view
666 begin
667 i := $80;
668 LogFile.write(i, 4);
669 end
670 else
671 LogFile.write(SaveMap, ((MapSize - 1) div 4 + 1) * 4);
672 for i := 0 to nPl - 1 do
673 if not Assigned(bix[i]) then
674 LogFile.write(zero, 4)
675 else
676 begin
677 if PlayersBrain[i].Kind in [btRandom, btAI] then
678 s := bix[i].FileName
679 else
680 s := PlayersBrain[i].FileName;
681 move(zero, s[Length(s) + 1], 4);
682 LogFile.write(s, (Length(s) div 4 + 1) * 4);
683 LogFile.write(OriginalDataVersion[i], 4);
684 s := ''; { behavior }
685 move(zero, s[Length(s) + 1], 4);
686 LogFile.write(s, (Length(s) div 4 + 1) * 4);
687 LogFile.write(Difficulty[i], 4);
688 end;
689
690 if auto and AutoSaveExists then
691 CL.AppendToFile(LogFile, AutoSaveState)
692 else
693 CL.SaveToFile(LogFile);
694 LogFile.Free;
695 if auto then
696 begin
697 AutoSaveState := CL.State;
698 AutoSaveExists := true
699 end
700end;
701
702procedure StartGame;
703var
704 i, p, p1, Human, nAlive, bixUni: integer;
705 Game: TNewGameData;
706 // GameEx: TNewGameExData;
707 Path: shortstring;
708 BrainUsed: Set of 0 .. 254; { used brains }
709 AIBrains: TBrains;
710begin
711 for p1 := 0 to nPl - 1 do begin
712 if Assigned(PlayersBrain[p1]) and (PlayersBrain[p1].Kind = btSuperVirtual) then
713 bix[p1] := BrainTerm // supervisor and local human use same module
714 else if Assigned(PlayersBrain[p1]) and (PlayersBrain[p1].Kind = btRandom) then
715 if Brains.GetKindCount(btAI) = 0 then
716 bix[p1] := nil
717 else begin
718 AIBrains := TBrains.Create(False);
719 Brains.GetByKind(btAI, AIBrains);
720 bix[p1] := AIBrains[DelphiRandom(AIBrains.Count)];
721 AIBrains.Free;
722 end
723 else
724 bix[p1] := PlayersBrain[p1];
725 if not Assigned(PlayersBrain[p1]) then
726 Difficulty[p1] := -1;
727 end;
728
729 if bix[0].Kind <> btNoTerm then
730 Notify(ntInitLocalHuman);
731 BrainUsed := [];
732 for p := 0 to nPl - 1 do
733 if Assigned(bix[p]) and ((Mode <> moMovie) or (p = 0)) then
734 begin { initiate selected control module }
735 AIInfo[p] := bix[p].Name + #0;
736 InitBrain(bix[p]);
737 if Mode = moPlaying then
738 begin // new game, this data version is original
739 OriginalDataVersion[p] := bix[p].DataVersion;
740 ProcessClientData[p] := true;
741 end
742 else // loading game, compare with data version read from file
743 ProcessClientData[p] := ProcessClientData[p] and
744 (OriginalDataVersion[p] = bix[p].DataVersion);
745 if @bix[p].Client = nil then // client function not found
746 if bix[0].Kind = btNoTerm then
747 bix[p] := nil
748 else
749 begin
750 bix[p] := BrainTerm;
751 OriginalDataVersion[p] := -1;
752 ProcessClientData[p] := false;
753 end;
754 if Assigned(bix[p]) then
755 include(BrainUsed, Brains.IndexOf(bix[p]));
756 end;
757
758 Notify(ntCreateWorld);
759 nAlive := 0;
760 GAlive := 0;
761 if Mode = moMovie then
762 GWatching := 1
763 else
764 GWatching := 0;
765 GAI := 0;
766 for p1 := 0 to nPl - 1 do
767 if Assigned(bix[p1]) then
768 begin
769 if Mode <> moMovie then
770 inc(GWatching, 1 shl p1);
771 if bix[p1].Kind = btAI then
772 inc(GAI, 1 shl p1);
773 if Difficulty[p1] > 0 then
774 begin
775 inc(GAlive, 1 shl p1);
776 inc(nAlive);
777 end;
778 ServerVersion[p1] := bix[p1].ServerVersion;
779 end;
780 WinOnAlone := (bix[0].Kind = btNoTerm) and (nAlive > 1);
781 GWinner := 0;
782 GColdWarStart := -ColdWarTurns - 1;
783 uixSelectedTransport := -1;
784 SpyMission := smSabotageProd;
785 for p1 := 0 to nPl - 1 do
786 DebugMap[p1] := nil;
787
788 GTurn := 0;
789 for i := 0 to 27 do
790 with GWonder[i] do
791 begin
792 CityID := -1;
793 EffectiveOwner := -1
794 end;
795 FillChar(GShip, SizeOf(GShip), 0);
796
797 for p := 0 to nPl - 1 do
798 if 1 shl p and (GAlive or GWatching) <> 0 then
799 with RW[p] do
800 begin
801 Government := gDespotism;
802 Money := StartMoney;
803 TaxRate := 30;
804 LuxRate := 0;
805 Research := 0;
806 ResearchTech := -2;
807 AnarchyStart := -AnarchyTurns - 1;
808 Happened := 0;
809 LastValidStat[p] := -1;
810 Worked[p] := 0;
811 Founded[p] := 0;
812 DevModelTurn[p] := -1;
813 OracleIncome := 0;
814
815 if bix[p].DataSize > 0 then
816 begin
817 GetMem(SavedData[p], bix[p].DataSize * 4);
818 GetMem(Data, bix[p].DataSize * 4);
819 FillChar(SavedData[p]^, bix[p].DataSize * 4, 0);
820 FillChar(Data^, bix[p].DataSize * 4, 0);
821 end
822 else
823 begin
824 Data := nil;
825 SavedData[p] := nil
826 end;
827 nBattleHistory := 0;
828 BattleHistory := nil;
829 { if bix[p]=bixTerm then
830 begin
831 GetMem(BorderHelper,MapSize);
832 FillChar(BorderHelper^,MapSize,0);
833 end
834 else } BorderHelper := nil;
835 for i := 0 to nStat - 1 do
836 GetMem(Stat[i, p], 4 * (MaxTurn + 1));
837 if bix[p].Flags and fDotNet <> 0 then
838 begin
839 GetMem(RW[p].DefaultDebugMap, MapSize * 4);
840 FillChar(RW[p].DefaultDebugMap^, MapSize * 4, 0);
841 DebugMap[p] := RW[p].DefaultDebugMap;
842 end
843 else
844 RW[p].DefaultDebugMap := nil;
845
846 { !!!for i:=0 to nShipPart-1 do GShip[p].Parts[i]:=Delphirandom((3-i)*2);{ }
847 end;
848
849 if LandMass > 0 then
850 begin // random map
851 InitRandomGame;
852 PreviewElevation := false;
853 MapField := nil;
854 end
855 else
856 begin // predefined map
857 if Mode = moPlaying then
858 LoadMap(MapFileName); // new game -- load map from file
859 GetMem(MapField, MapSize * 4);
860 move(RealMap, MapField^, MapSize * 4);
861 Human := 0;
862 for p1 := 0 to nPl - 1 do
863 if bix[p1].Kind = btTerm then
864 inc(Human, 1 shl p1);
865 InitMapGame(Human);
866 end;
867 CityProcessing.InitGame;
868 UnitProcessing.InitGame;
869 for p := 0 to nPl - 1 do
870 if 1 shl p and (GAlive or GWatching) <> 0 then
871 Inform(p);
872
873 pTurn := -1;
874 if bix[0].Kind <> btNoTerm then
875 Notify(ntInitLocalHuman);
876 Game.lx := lx;
877 Game.ly := ly;
878 Game.LandMass := LandMass;
879 Game.MaxTurn := MaxTurn;
880 move(Difficulty, Game.Difficulty, SizeOf(Difficulty));
881 // GameEx.lx:=lx; GameEx.ly:=ly; GameEx.LandMass:=LandMass;
882 // GameEx.MaxTurn:=MaxTurn; GameEx.RND:=RND;
883 // move(Difficulty,GameEx.Difficulty,SizeOf(Difficulty));
884 AICredits := '';
885 for i := 0 to Brains.Count - 1 do
886 with Brains[I] do begin
887 if Initialized then
888 if i in BrainUsed then
889 begin
890 if Kind = btAI then
891 Notify(ntInitPlayers);
892 for p := 0 to nPl - 1 do
893 begin
894 if Brains.IndexOf(bix[p]) = i then
895 Game.RO[p] := @RW[p]
896 else
897 Game.RO[p] := nil;
898 if (Kind = btTerm) and (Difficulty[0] = 0) and Assigned(bix[p]) then
899 Game.SuperVisorRO[p] := @RW[p]
900 else
901 Game.SuperVisorRO[p] := nil;
902 end;
903 if Flags and fDotNet > 0 then
904 begin
905 Path := DLLName;
906 move(Path[1], Game.AssemblyPath, Length(Path));
907 Game.AssemblyPath[Length(Path)] := #0;
908 end
909 else
910 Game.AssemblyPath[0] := #0;
911 case Mode of
912 moLoading, moLoading_Fast:
913 CallClient(i, cLoadGame, Game);
914 moMovie:
915 CallClient(i, cMovie, Game);
916 moPlaying:
917 CallClient(i, cNewGame, Game);
918 end;
919 if (Kind = btAI) and (Credits <> '') then
920 if AICredits = '' then
921 AICredits := Credits
922 else
923 AICredits := AICredits + '\' + Credits;
924 end
925 else
926 begin { module no longer used -- unload }
927 CallClient(i, cReleaseModule, nil^);
928 if Kind = btAI then
929 begin
930 if Flags and fDotNet = 0 then
931 FreeLibrary(hm);
932 Client := nil;
933 end;
934 Initialized := false;
935 end;
936 end;
937 AICredits := AICredits + #0;
938
939 if bix[0].Kind <> btNoTerm then
940 begin
941 // uni ai?
942 bixUni := -1;
943 for p1 := 0 to nPl - 1 do
944 if Assigned(bix[p1]) and (bix[p1].Kind = btAI) then
945 if bixUni = -1 then
946 bixUni := Brains.IndexOf(bix[p1])
947 else if bixUni <> Brains.IndexOf(bix[p1]) then
948 bixUni := -2;
949 for p1 := 0 to nPl - 1 do
950 if Assigned(bix[p1]) and (bix[p1].Kind = btAI) then
951 begin
952 if bixUni = -2 then
953 NotifyMessage := bix[p1].FileName
954 else
955 NotifyMessage := '';
956 Notify(ntSetAIName + p1);
957 end
958 end;
959
960 CheckBorders(-1);
961{$IFOPT O-}InvalidTreatyMap := 0; {$ENDIF}
962 AutoSaveExists := false;
963 pDipActive := -1;
964 pTurn := 0;
965
966 if Mode >= moMovie then
967 Notify(ntEndInfo);
968end; { StartGame }
969
970procedure EndGame;
971var
972 i, p1: integer;
973begin
974 if LandMass = 0 then
975 FreeMem(MapField);
976 for p1 := 0 to nPl - 1 do
977 if Assigned(bix[p1]) then
978 begin
979 for i := 0 to nStat - 1 do
980 FreeMem(Stat[i, p1]);
981 if RW[p1].BattleHistory <> nil then
982 FreeMem(RW[p1].BattleHistory);
983 { if RW[p1].BorderHelper<>nil then FreeMem(RW[p1].BorderHelper); }
984 FreeMem(RW[p1].Data);
985 FreeMem(SavedData[p1]);
986 if RW[p1].DefaultDebugMap <> nil then
987 FreeMem(RW[p1].DefaultDebugMap);
988 end;
989 UnitProcessing.ReleaseGame;
990 CityProcessing.ReleaseGame;
991 Database.ReleaseGame;
992 CL.Free;
993end;
994
995procedure GenerateStat(p: integer);
996var
997 cix, uix: integer;
998begin
999 if Difficulty[p] > 0 then
1000 with RW[p] do
1001 begin
1002 Stat[stPop, p, GTurn] := 0;
1003 for cix := 0 to nCity - 1 do
1004 if City[cix].Loc >= 0 then
1005 inc(Stat[stPop, p, GTurn], City[cix].Size);
1006 Stat[stScience, p, GTurn] := Researched[p] * 50;
1007 if (RW[p].ResearchTech >= 0) and (RW[p].ResearchTech <> adMilitary) then
1008 inc(Stat[stScience, p, GTurn], Research * 100 div TechBaseCost(nTech[p],
1009 Difficulty[p]));
1010 Stat[stMil, p, GTurn] := 0;
1011 for uix := 0 to nUn - 1 do
1012 if Un[uix].Loc >= 0 then
1013 with Model[Un[uix].mix] do
1014 begin
1015 if (Kind <= mkEnemyDeveloped) and (Un[uix].mix <> 1) then
1016 inc(Stat[stMil, p, GTurn], Weight * MStrength *
1017 Un[uix].Health div 100)
1018 else if Domain = dGround then
1019 inc(Stat[stMil, p, GTurn], (Attack + 2 * Defense) *
1020 Un[uix].Health div 100)
1021 else
1022 inc(Stat[stMil, p, GTurn], (Attack + Defense) *
1023 Un[uix].Health div 100);
1024 case Kind of
1025 mkSlaves:
1026 inc(Stat[stPop, p, GTurn]);
1027 mkSettler:
1028 inc(Stat[stPop, p, GTurn], 2);
1029 end;
1030 end;
1031 Stat[stMil, p, GTurn] := Stat[stMil, p, GTurn] div 16;
1032 Stat[stExplore, p, GTurn] := Discovered[p];
1033 Stat[stTerritory, p, GTurn] := TerritoryCount[p];
1034 Stat[stWork, p, GTurn] := Worked[p];
1035 LastValidStat[p] := GTurn;
1036 end;
1037end;
1038
1039procedure LogCityTileChanges;
1040var
1041 cix: integer;
1042begin
1043 for cix := 0 to RW[pTurn].nCity - 1 do
1044 with RW[pTurn].City[cix] do
1045 if Loc >= 0 then
1046 begin
1047 { if SavedResourceWeights[cix]<>ResourceWeights then
1048 begin // log city resource weight changes
1049 CL.Put(sSetCityResourceWeights, pTurn, cix, @ResourceWeights);
1050 SavedResourceWeights[cix]:=ResourceWeights;
1051 end; }
1052 if SavedTiles[cix] <> Tiles then
1053 begin // log city tile changes
1054 CL.Put(sSetCityTiles, pTurn, cix, @Tiles);
1055 SavedTiles[cix] := Tiles;
1056 end;
1057 end;
1058end;
1059
1060procedure NoLogCityTileChanges;
1061var
1062 cix: integer;
1063begin
1064 for cix := 0 to RW[pTurn].nCity - 1 do
1065 with RW[pTurn].City[cix] do
1066 if Loc >= 0 then
1067 begin
1068 // SavedResourceWeights[cix]:=ResourceWeights;
1069 SavedTiles[cix] := Tiles;
1070 end;
1071end;
1072
1073function HasCityTileChanges: boolean;
1074var
1075 cix: integer;
1076begin
1077 result := false;
1078 for cix := 0 to RW[pTurn].nCity - 1 do
1079 with RW[pTurn].City[cix] do
1080 if Loc >= 0 then
1081 begin
1082 // if SavedResourceWeights[cix]<>ResourceWeights then result:=true;
1083 if SavedTiles[cix] <> Tiles then
1084 result := true;
1085 end;
1086end;
1087
1088procedure BeforeTurn0;
1089var
1090 p1, uix: integer;
1091begin
1092 for uix := 0 to RW[pTurn].nUn - 1 do { init movement points for first turn }
1093 with RW[pTurn].Un[uix] do
1094 Movement := RW[pTurn].Model[mix].Speed;
1095
1096 if Difficulty[pTurn] > 0 then
1097 DiscoverViewAreas(pTurn)
1098 else { supervisor }
1099 begin
1100 DiscoverAll(pTurn, lObserveSuper);
1101 for p1 := 1 to nPl - 1 do
1102 if 1 shl p1 and GAlive <> 0 then
1103 begin
1104 GiveCivilReport(pTurn, p1);
1105 GiveMilReport(pTurn, p1)
1106 end;
1107 end;
1108 // CheckContact;
1109end;
1110
1111function LoadGame(const Path, FileName: string; Turn: integer;
1112 MovieMode: boolean): boolean;
1113var
1114 J: TBrain;
1115 i, ix, d, p1, Command, Subject: integer;
1116 K: Integer;
1117{$IFDEF TEXTLOG}LoadPos0: integer; {$ENDIF}
1118 Data: pointer;
1119 LogFile: TFileStream;
1120 FormerCLState: TCmdListState;
1121 s: string[255];
1122 SaveMap: array [0 .. lxmax * lymax - 1] of Byte;
1123 Started, StatRequest: boolean;
1124begin
1125 SavePath := Path;
1126 LogFileName := FileName;
1127 LoadTurn := Turn;
1128 LogFile := TFileStream.Create(SavePath + LogFileName, fmOpenRead or
1129 fmShareExclusive);
1130 LogFile.Position := 0;
1131 LogFile.Read(s[1], 8); { file id }
1132 LogFile.Read(i, 4); { c-evo version }
1133 LogFile.Read(J, 4); { exe time }
1134
1135 if (i >= FirstBookCompatibleVersion) and (i <= Version) then
1136 begin
1137 result := true;
1138 LogFile.Read(lx, 4);
1139 LogFile.Read(ly, 4);
1140 MapSize := lx * ly;
1141 LogFile.Read(LandMass, 4);
1142 if LandMass = 0 then
1143 LogFile.Read(RealMap, MapSize * 4); // use predefined map
1144 LogFile.Read(MaxTurn, 4);
1145 LogFile.Read(RND, 4);
1146 LogFile.Read(GTurn, 4);
1147 LogFile.Read(SaveMap, 4);
1148 if SaveMap[0] <> $80 then
1149 LogFile.read(SaveMap[4], ((MapSize - 1) div 4 + 1) * 4 - 4);
1150 for p1 := 0 to nPl - 1 do
1151 begin
1152 LogFile.Read(s[0], 4);
1153 if s[0] = #0 then
1154 PlayersBrain[p1] := nil
1155 else
1156 begin
1157 LogFile.Read(s[4], Byte(s[0]) div 4 * 4);
1158 LogFile.Read(OriginalDataVersion[p1], 4);
1159 LogFile.Read(d, 4); { behavior }
1160 LogFile.Read(Difficulty[p1], 4);
1161 J := Brains.Last;
1162 while Assigned(J) and (AnsiCompareFileName(J.FileName, s) <> 0) do begin
1163 K := Brains.IndexOf(J) - 1;
1164 if K >= 0 then J := Brains[K]
1165 else J := nil;
1166 end;
1167 if not Assigned(J) then
1168 begin // ai not found -- replace by local player
1169 ProcessClientData[p1] := false;
1170 NotifyMessage := s;
1171 Notify(ntAIError);
1172 J := BrainTerm;
1173 end
1174 else
1175 ProcessClientData[p1] := true;
1176 if j.Kind = btNoTerm then
1177 j := BrainSuperVirtual;
1178 // crashed tournament -- load as supervisor
1179 PlayersBrain[p1] := j;
1180 end;
1181 end;
1182 end
1183 else
1184 Result := false;
1185
1186 if Result then begin
1187 CL := TCmdList.Create;
1188 CL.LoadFromFile(LogFile);
1189 end;
1190 LogFile.Free;
1191 if not result then
1192 Exit;
1193
1194 Notify(ntStartDone);
1195 if LoadTurn < 0 then
1196 LoadTurn := GTurn;
1197 if MovieMode then
1198 Mode := moMovie
1199 else if LoadTurn = 0 then
1200 Mode := moLoading
1201 else
1202 Mode := moLoading_Fast;
1203{$IFDEF TEXTLOG}AssignFile(TextLog, SavePath + LogFileName + '.txt');
1204 Rewrite(TextLog); {$ENDIF}
1205 LoadOK := true;
1206 StartGame;
1207 if MovieMode then
1208 begin
1209 bix[0].Client(cShowGame, 0, nil^);
1210 Notify(ntBackOff);
1211 end
1212 else
1213 Notify(ntLoadBegin);
1214
1215 started := false;
1216 StatRequest := false;
1217 MovieStopped := false;
1218{$IFDEF LOADPERF}QueryPerformanceCounter(time_total0);
1219 time_a := 0;
1220 time_b := 0;
1221 time_c := 0; {$ENDIF}
1222 while not MovieStopped and (CL.Progress < 1000) do
1223 begin
1224 FormerCLState := CL.State;
1225 CL.Get(Command, p1, Subject, Data);
1226 if p1 < 0 then
1227 p1 := pTurn;
1228 if StatRequest and (Command and (sctMask or sExecute) <> sctInternal or
1229 sExecute) then
1230 begin
1231 GenerateStat(pTurn);
1232 StatRequest := false
1233 end;
1234 // complete all internal commands following an sTurn before generating statistics
1235 if (Command = sTurn) and not started then
1236 begin
1237{$IFDEF TEXTLOG}WriteLn(TextLog, '---Turn 0 P0---'); {$ENDIF}
1238 for p1 := 0 to nPl - 1 do
1239 if Assigned(bix[p1]) and ((Mode <> moMovie) or (p1 = 0)) then
1240 CallPlayer(cReplay, p1, nil^);
1241 BeforeTurn0;
1242 if MovieMode then
1243 begin
1244 Inform(pTurn);
1245 CallPlayer(cMovieTurn, 0, nil^);
1246 end;
1247 StatRequest := true;
1248 started := true;
1249 end
1250 else if (Command = sTurn) and (pTurn = 0) and (GTurn = LoadTurn) then
1251 begin
1252 assert(CL.State.LoadPos = FormerCLState.LoadPos + 4); // size of sTurn
1253 CL.State := FormerCLState;
1254 CL.Cut;
1255 Break;
1256 end
1257 else if Command = sIntDataChange then
1258 begin
1259{$IFDEF TEXTLOG}LoadPos0 := CL.State.LoadPos; {$ENDIF}
1260 if ProcessClientData[p1] then
1261 CL.GetDataChanges(RW[p1].Data, bix[p1].DataSize)
1262 else
1263 CL.GetDataChanges(nil, 0);
1264{$IFDEF TEXTLOG}WriteLn(TextLog, Format('Data Changes P%d (%d Bytes)', [p1, CL.State.LoadPos - LoadPos0])); {$ENDIF}
1265 end
1266 else
1267 begin
1268{$IFDEF TEXTLOG}CmdInfo := Format('Command %x', [Command]); {$ENDIF}
1269 if Command and (sctMask or sExecute) = sctInternal or sExecute then
1270 IntServer(Command, p1, Subject, Data^) // internal command
1271 else
1272 begin
1273 StatRequest := Command = sTurn;
1274 Server(Command, p1, Subject, Data^);
1275 end;
1276{$IFDEF TEXTLOG}WriteLn(TextLog, CmdInfo); {$ENDIF}
1277 end;
1278 if not MovieMode then
1279 Notify(ntLoadState + CL.Progress * 128 div 1000);
1280 end;
1281
1282 if MovieMode then
1283 begin
1284 Notify(ntBackOn);
1285 bix[0].Client(cBreakGame, -1, nil^);
1286 EndGame;
1287 Notify(ntStartGo);
1288 result := false;
1289 exit;
1290 end;
1291
1292 if StatRequest then
1293 GenerateStat(pTurn);
1294 assert(started);
1295{$IFDEF TEXTLOG}CloseFile(TextLog); {$ENDIF}
1296{$IFDEF LOADPERF}QueryPerformanceCounter(time_total); { time in s is: (time_total-time_total0)/PerfFreq }{$ENDIF}
1297 NoLogChanges;
1298 NoLogCityTileChanges;
1299 if LogFileName[1] = '~' then
1300 begin
1301 Delete(LogFileName, 1, 1);
1302 nLogOpened := -1
1303 end
1304 else
1305 nLogOpened := CL.State.nLog;
1306
1307 Mode := moPlaying;
1308 LastEndClientCommand := -1;
1309 if (GTestFlags and tfUncover <> 0) or (Difficulty[pTurn] = 0) then
1310 DiscoverAll(pTurn, lObserveSuper) { supervisor - all tiles visible }
1311 else
1312 DiscoverViewAreas(pTurn);
1313
1314 for p1 := 0 to nPl - 1 do
1315 if 1 shl p1 and (GAlive or GWatching) <> 0 then
1316 begin
1317 RecalcPeaceMap(p1);
1318 for ix := 0 to RW[p1].nEnemyUn - 1 do
1319 with RW[p1].EnemyUn[ix] do
1320 emix := RWemix[p1, Owner, mix];
1321 Inform(p1);
1322 end;
1323{$IFOPT O-}CheckBorders(-2); {$ENDIF} // for testing only
1324 Notify(ntEndInfo);
1325 if not LoadOK then
1326 begin
1327 NotifyMessage := SavePath + LogFileName;
1328 Notify(ntLoadError);
1329 end;
1330 bix[0].Client(cShowGame, 0, nil^);
1331 Notify(ntBackOff);
1332 Inform(pTurn);
1333 ChangeClientWhenDone(cResume, 0, nil^, 0);
1334end; // LoadGame
1335
1336procedure InsertTerritoryUpdateCommands;
1337var
1338 p1, Command, Subject: integer;
1339 Data: pointer;
1340 FormerCLState: TCmdListState;
1341begin
1342 while CL.Progress < 1000 do
1343 begin
1344 FormerCLState := CL.State;
1345 CL.Get(Command, p1, Subject, Data);
1346 if (Command = sIntExpandTerritory) and (p1 = pTurn) then
1347 begin
1348 IntServer(Command, p1, Subject, Data^);
1349{$IFDEF TEXTLOG}WriteLn(TextLog, 'AfterTurn - ExpandTerritory'); {$ENDIF}
1350 end
1351 else
1352 begin
1353 CL.State := FormerCLState;
1354 Break
1355 end
1356 end;
1357{$IFOPT O-}InvalidTreatyMap := 0; {$ENDIF}
1358end;
1359
1360procedure StartNewGame(const Path, FileName, Map: string;
1361 Newlx, Newly, NewLandMass, NewMaxTurn: integer);
1362var
1363 p: integer;
1364begin
1365 Notify(ntStartDone);
1366 SavePath := Path;
1367 LogFileName := FileName;
1368 MapFileName := Map;
1369 if FastContact then
1370 begin
1371 lx := 24;
1372 ly := 42;
1373 end
1374 else
1375 begin
1376 lx := Newlx;
1377 ly := Newly
1378 end;
1379 MapSize := lx * ly;
1380 if MapFileName <> '' then
1381 LandMass := 0
1382 else
1383 LandMass := NewLandMass;
1384 MaxTurn := NewMaxTurn;
1385 DelphiRandomize;
1386 RND := DelphiRandSeed;
1387 Mode := moPlaying;
1388 CL := TCmdList.Create;
1389 StartGame;
1390 NoLogChanges;
1391 for p := 0 to nPl - 1 do
1392 if Assigned(bix[p]) then
1393 CallPlayer(cGetReady, p, nil^);
1394 LogChanges;
1395 CL.Put(sTurn, 0, 0, nil);
1396 BeforeTurn0;
1397 NoLogCityTileChanges;
1398 GenerateStat(pTurn);
1399 nLogOpened := -1;
1400 LastEndClientCommand := -1;
1401 bix[0].Client(cShowGame, 0, nil^);
1402 Notify(ntBackOff);
1403 Inform(pTurn);
1404 ChangeClientWhenDone(cTurn, 0, nil^, 0)
1405end;
1406
1407procedure DirectHelp(Command: integer);
1408begin
1409 InitBrain(BrainTerm);
1410 BrainTerm.Client(Command, -1, nil^);
1411 AICredits := #0;
1412end;
1413
1414procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: integer);
1415var
1416 p1, Loc1: integer;
1417 Game: TNewGameData;
1418begin
1419 Notify(ntStartDone);
1420 Notify(ntInitLocalHuman);
1421 MapFileName := Map;
1422 lx := Newlx;
1423 ly := Newly;
1424 MapSize := lx * ly;
1425 LandMass := NewLandMass;
1426 bix[0] := BrainTerm;
1427 Difficulty[0] := 0;
1428 InitBrain(BrainTerm);
1429
1430 DelphiRandomize;
1431 GAlive := 0;
1432 GWatching := 1;
1433 if not LoadMap(MapFileName) then
1434 for Loc1 := 0 to MapSize - 1 do
1435 RealMap[Loc1] := fOcean or ($F shl 27);
1436 CL := nil;
1437 InitMapEditor;
1438 RW[0].Data := nil;
1439 RW[0].BorderHelper := nil;
1440 RW[0].Alive := 0;
1441 Game.lx := lx;
1442 Game.ly := ly;
1443 Game.RO[0] := @RW[0];
1444 Game.Difficulty[0] := 0;
1445 for p1 := 1 to nPl - 1 do
1446 begin
1447 Game.RO[p1] := nil;
1448 Game.Difficulty[p1] := -1
1449 end;
1450 BrainTerm.Client(cNewMap, -1, Game);
1451
1452 DiscoverAll(0, lObserveSuper);
1453 Notify(ntEndInfo);
1454 bix[0].Client(cShowGame, 0, nil^);
1455 Notify(ntBackOff);
1456 ChangeClientWhenDone(cEditMap, 0, nil^, 0)
1457end;
1458
1459procedure DestroySpacePort_TellPlayers(p, pCapturer: integer);
1460var
1461 cix, i, p1: integer;
1462 ShowShipChange: TShowShipChange;
1463begin
1464 // stop ship part production
1465 for cix := 0 to RW[p].nCity - 1 do
1466 with RW[p].City[cix] do
1467 if (Loc >= 0) and (Project and cpImp <> 0) and
1468 ((Project and cpIndex = woMIR) or
1469 (Imp[Project and cpIndex].Kind = ikShipPart)) then
1470 begin
1471 inc(RW[p].Money, Prod0);
1472 Prod := 0;
1473 Prod0 := 0;
1474 Project := cpImp + imTrGoods;
1475 Project0 := cpImp + imTrGoods
1476 end;
1477
1478 // destroy ship
1479 with GShip[p] do
1480 if Parts[0] + Parts[1] + Parts[2] > 0 then
1481 begin
1482 for i := 0 to nShipPart - 1 do
1483 begin
1484 ShowShipChange.Ship1Change[i] := -Parts[i];
1485 if pCapturer >= 0 then
1486 begin
1487 ShowShipChange.Ship2Change[i] := Parts[i];
1488 inc(GShip[pCapturer].Parts[i], Parts[i]);
1489 end;
1490 Parts[i] := 0;
1491 end;
1492 if Mode >= moMovie then
1493 begin
1494 if pCapturer >= 0 then
1495 ShowShipChange.Reason := scrCapture
1496 else
1497 ShowShipChange.Reason := scrDestruction;
1498 ShowShipChange.Ship1Owner := p;
1499 ShowShipChange.Ship2Owner := pCapturer;
1500 for p1 := 0 to nPl - 1 do
1501 if 1 shl p1 and (GAlive or GWatching) <> 0 then
1502 begin
1503 move(GShip, RW[p1].Ship, SizeOf(GShip));
1504 if 1 shl p1 and GWatching <> 0 then
1505 CallPlayer(cShowShipChange, p1, ShowShipChange);
1506 end;
1507 end
1508 end
1509end;
1510
1511procedure DestroyCity_TellPlayers(p, cix: integer; SaveUnits: boolean);
1512begin
1513 if RW[p].City[cix].built[imSpacePort] > 0 then
1514 DestroySpacePort_TellPlayers(p, -1);
1515 DestroyCity(p, cix, SaveUnits);
1516end;
1517
1518procedure ChangeCityOwner_TellPlayers(pOld, cixOld, pNew: integer);
1519begin
1520 if RW[pOld].City[cixOld].built[imSpacePort] > 0 then
1521 if RW[pNew].NatBuilt[imSpacePort] > 0 then
1522 DestroySpacePort_TellPlayers(pOld, pNew)
1523 else
1524 DestroySpacePort_TellPlayers(pOld, -1);
1525 ChangeCityOwner(pOld, cixOld, pNew);
1526end;
1527
1528procedure CheckWin(p: integer);
1529var
1530 i: integer;
1531 ShipComplete: boolean;
1532begin
1533 ShipComplete := true;
1534 for i := 0 to nShipPart - 1 do
1535 if GShip[p].Parts[i] < ShipNeed[i] then
1536 ShipComplete := false;
1537 if ShipComplete then
1538 GWinner := GWinner or 1 shl p; // game won!
1539end;
1540
1541procedure BeforeTurn;
1542var
1543 i, p1, uix, cix, V21, Loc1, Cost, Job0, nAlive, nAppliers, ad, OldLoc,
1544 SiegedTiles, nUpdateLoc: integer;
1545 UpdateLoc: array [0 .. numax - 1] of integer;
1546 Radius: TVicinity21Loc;
1547 ShowShipChange: TShowShipChange;
1548 TribeExtinct, JobDone, MirBuilt: boolean;
1549begin
1550{$IFOPT O-}assert(1 shl pTurn and InvalidTreatyMap = 0); {$ENDIF}
1551 assert(1 shl pTurn and (GAlive or GWatching) <> 0);
1552 if (1 shl pTurn and GAlive = 0) and (Difficulty[pTurn] > 0) then
1553 exit;
1554
1555 if (GWonder[woGrLibrary].EffectiveOwner = pTurn) and (GWinner = 0) then
1556 begin // check great library effect
1557 nAlive := 0;
1558 for p1 := 0 to nPl - 1 do
1559 if 1 shl p1 and GAlive <> 0 then
1560 inc(nAlive);
1561 ad := 0;
1562 while ad <= (nAdv - 5) do begin
1563 if RW[pTurn].Tech[ad] < tsSeen then
1564 begin
1565 nAppliers := 0;
1566 for p1 := 0 to nPl - 1 do
1567 if (p1 <> pTurn) and (1 shl p1 and GAlive <> 0) and
1568 (RW[p1].Tech[ad] >= tsApplicable) then
1569 inc(nAppliers);
1570 if nAppliers * 2 > nAlive then
1571 begin
1572 SeeTech(pTurn, ad);
1573 inc(nTech[pTurn]);
1574 if Mode >= moMovie then
1575 CallPlayer(cShowGreatLibTech, pTurn, ad);
1576 // do not call CallPlayer(pTurn) while map is invalid
1577 end;
1578 end;
1579 Inc(ad);
1580 end;
1581 end;
1582
1583 MaskD(ObserveLevel, MapSize, not Cardinal(3 shl (2 * pTurn)));
1584 if Mode > moLoading_Fast then
1585 MaskD(RW[pTurn].Map^, MapSize, Cardinal(not Cardinal(fUnit or fHiddenUnit or
1586 fStealthUnit or fObserved or fSpiedOut or fOwned or fOwnZoCUnit or
1587 fInEnemyZoC)));
1588 RW[pTurn].nEnemyUn := 0;
1589
1590 MirBuilt := false;
1591 if (Difficulty[pTurn] > 0) and (GWinner = 0) then
1592 with RW[pTurn] do
1593 begin
1594 if nCity > 0 then
1595 for p1 := 0 to nPl - 1 do
1596 if GTurn = EvaStart[p1] + PeaceEvaTurns then
1597 begin // peace contract -- remove all units from p1's territory
1598 Loc1 := City[0].Loc; // search destination for homeless units
1599 for cix := 1 to nCity - 1 do
1600 if (City[cix].Loc >= 0) and
1601 ((Loc1 < 0) or (City[cix].built[imPalace] > 0)) then
1602 Loc1 := City[cix].Loc;
1603 for uix := 0 to nUn - 1 do
1604 with Un[uix] do
1605 if (Loc >= 0) and (Model[mix].Kind <> mkDiplomat) and
1606 ((Home >= 0) or (Loc1 >= 0)) and
1607 (RealMap[Loc] shr 27 = Cardinal(p1)) then
1608 begin
1609 OldLoc := Loc;
1610 if Master >= 0 then
1611 begin // transport unload
1612 if Model[mix].Domain = dAir then
1613 dec(Un[Master].AirLoad)
1614 else
1615 dec(Un[Master].TroopLoad);
1616 Master := -1;
1617 end
1618 else
1619 FreeUnit(pTurn, uix);
1620
1621 if Home >= 0 then
1622 Loc := City[Home].Loc
1623 else
1624 Loc := Loc1;
1625 PlaceUnit(pTurn, uix);
1626 UpdateUnitMap(OldLoc);
1627 UpdateUnitMap(Loc);
1628 Flags := Flags or unWithdrawn;
1629 Happened := Happened or phPeaceEvacuation;
1630 end
1631 end;
1632
1633 if Mode >= moMovie then
1634 FillChar(ShowShipChange, SizeOf(ShowShipChange), 0);
1635 TribeExtinct := true;
1636 nUpdateLoc := 0;
1637 for cix := 0 to nCity - 1 do
1638 with City[cix] do
1639 if Loc >= 0 then
1640 begin { next turn for all cities - city loop 1 }
1641 // if ServerVersion[pTurn]>=$000EF0 then
1642 // Flags:=Flags and (chFounded or chCaptured or chProductionSabotaged or chDisorder)
1643 // else Flags:=Flags and (chCaptured or chProductionSabotaged or chDisorder);
1644 // check for siege
1645 SiegedTiles := 0;
1646 V21_to_Loc(Loc, Radius);
1647 for V21 := 1 to 26 do
1648 if Tiles and (1 shl V21) and not(1 shl CityOwnTile) <> 0 then
1649 begin
1650 Loc1 := Radius[V21];
1651 assert((Loc1 >= 0) and (Loc1 < MapSize) and
1652 (UsedByCity[Loc1] = Loc));
1653 p1 := RealMap[Loc1] shr 27;
1654 if (RealMap[Loc1] and fCity <> 0) or (p1 < nPl) and
1655 (p1 <> pTurn) and (RW[pTurn].Treaty[p1] >= trPeace) or
1656 (ZoCMap[Loc1] > 0) and (Occupant[Loc1] <> pTurn) and
1657 (Treaty[Occupant[Loc1]] < trPeace) then
1658 begin
1659 Tiles := Tiles and not(1 shl V21);
1660 UsedByCity[Loc1] := -1;
1661 Flags := Flags or chSiege;
1662 inc(SiegedTiles);
1663 end;
1664 end;
1665 while SiegedTiles > 0 do // replace sieged tiles
1666 begin
1667 if not AddBestCityTile(pTurn, cix) then
1668 Break;
1669 dec(SiegedTiles);
1670 end;
1671
1672 if Flags and chFounded = 0 then
1673 begin
1674 // CollectCityResources(pTurn,cix); // old style
1675
1676 if CityTurn(pTurn, cix) then
1677 TribeExtinct := false
1678 else
1679 begin // city is erased
1680 RemoveDomainUnits(dSea, pTurn, Loc);
1681 RemoveDomainUnits(dAir, pTurn, Loc);
1682 Map[Loc] := Map[Loc] and not fCity; // !!! do this in inner core
1683 UpdateLoc[nUpdateLoc] := Loc;
1684 inc(nUpdateLoc);
1685 DestroyCity_TellPlayers(pTurn, cix, true);
1686 end;
1687
1688 if (Flags and chProduction <> 0) and (Project0 and cpImp <> 0)
1689 then
1690 begin
1691 if Project0 and cpIndex = woMIR then // MIR completed
1692 MirBuilt := true
1693 else if Project0 and cpIndex = woManhattan then
1694 GColdWarStart := GTurn
1695 else if Imp[Project0 and cpIndex].Kind = ikShipPart
1696 then { ship parts produced }
1697 inc(ShowShipChange.Ship1Change[Project0 and cpIndex -
1698 imShipComp]);
1699 end
1700 end
1701 end; { city loop 1 }
1702 if nUpdateLoc > 0 then
1703 begin
1704 CheckBorders(-1, pTurn);
1705 for i := 0 to nUpdateLoc - 1 do
1706 UpdateUnitMap(UpdateLoc[i], true);
1707 if Mode >= moMovie then
1708 for p1 := 0 to nPl - 1 do
1709 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) then
1710 for i := 0 to nUpdateLoc - 1 do
1711 if ObserveLevel[UpdateLoc[i]] shr (2 * p1) and 3 >= lObserveUnhidden
1712 then
1713 CallPlayer(cShowCityChanged, p1, UpdateLoc[i]);
1714 end;
1715
1716 for uix := 0 to nUn - 1 do
1717 with Un[uix] do
1718 if Loc >= 0 then
1719 begin // unit loop 2
1720 if Health < 100 then
1721 Recover(pTurn, uix);
1722
1723 if Flags and unMountainDelay <> 0 then
1724 begin
1725 Movement := 0;
1726 Flags := Flags and not unMountainDelay
1727 end
1728 else
1729 Movement := UnitSpeed(pTurn, mix, Health); { refresh movement }
1730
1731 assert(Loc >= 0);
1732 if Model[mix].Kind <> mkDiplomat then
1733 begin // check treaty violation
1734 p1 := RealMap[Loc] shr 27;
1735 if (p1 < nPl) and (p1 <> pTurn) and (Treaty[p1] >= trPeace) then
1736 begin
1737 if (Job in [jCity, jPillage, jClear, jAfforest, jTrans]) or
1738 (Job in [jIrr, jMine, jFort, jBase]) and
1739 (RealMap[Loc] and fTerImp <> 0) then
1740 Job := jNone;
1741 if (GTurn > EvaStart[p1] + PeaceEvaTurns) and
1742 (Treaty[p1] <> trAlliance) then
1743 begin
1744 EvaStart[p1] := GTurn;
1745 Happened := Happened or phPeaceViolation;
1746 if Mode >= moMovie then
1747 CallPlayer(cShowPeaceViolation, p1, pTurn);
1748 end;
1749 end;
1750 end;
1751
1752 if ServerVersion[pTurn] >= $000EF0 then
1753 begin
1754 if (Health <= 0) or TribeExtinct then
1755 RemoveUnit_UpdateMap(pTurn, uix);
1756 end
1757 end;
1758
1759 if ServerVersion[pTurn] < $000EF0 then
1760 for uix := 0 to nUn - 1 do
1761 with Un[uix] do
1762 if Loc >= 0 then
1763 begin // unit loop 3
1764 Loc1 := Loc;
1765 Job0 := Job;
1766 if Job <> jNone then
1767 JobDone := Work(pTurn, uix);
1768 { settlers do terrain improvement jobs }
1769 if (Health <= 0) or TribeExtinct then
1770 RemoveUnit_UpdateMap(pTurn, uix);
1771
1772 if (Job0 = jCity) and JobDone then // new city
1773 begin
1774 AddBestCityTile(pTurn, RW[pTurn].nCity - 1);
1775 UpdateUnitMap(Loc1, true);
1776 if Mode >= moMovie then // tell enemies
1777 for p1 := 0 to nPl - 1 do
1778 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) and
1779 (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then
1780 CallPlayer(cShowCityChanged, p1, Loc1);
1781 end
1782 end;
1783
1784 { pollution - city loop 3 }
1785 for cix := 0 to nCity - 1 do
1786 with City[cix] do
1787 if (Loc >= 0) and (Pollution >= MaxPollution) then
1788 Pollute(pTurn, cix);
1789
1790 CompactLists(pTurn);
1791 if (nUn = 0) and (nCity = 0) then
1792 begin // nation made extinct
1793 Happened := Happened or phExtinct;
1794 GAlive := GAlive and not(1 shl pTurn);
1795 Stat[stPop, pTurn, GTurn] := 0;
1796 Stat[stMil, pTurn, GTurn] := 0;
1797 Stat[stScience, pTurn, GTurn] := 0;
1798 Stat[stExplore, pTurn, GTurn] := 0;
1799 Stat[stTerritory, pTurn, GTurn] := 0;
1800 Stat[stWork, pTurn, GTurn] := 0;
1801 for p1 := 0 to nPl - 1 do
1802 if 1 shl p1 and (GAlive or GWatching) <> 0 then
1803 begin
1804 if p1 <> pTurn then
1805 begin
1806 GiveCivilReport(p1, pTurn);
1807 if (GTestFlags and tfUncover <> 0) or (Difficulty[p1] = 0) or
1808 (RW[p1].Treaty[pTurn] = trAlliance) then
1809 GiveMilReport(p1, pTurn);
1810 end;
1811 with RW[p1] do
1812 begin
1813 Alive := GAlive;
1814 for Loc1 := 0 to MapSize - 1 do
1815 if Territory[Loc1] = pTurn then
1816 // remove territory of extinct nation from player maps
1817 begin
1818 Territory[Loc1] := -1;
1819 Map[Loc1] := Map[Loc1] and not fPeace
1820 end
1821 end;
1822 end;
1823 exit
1824 end;
1825
1826 // check research
1827 Cost := TechCost(pTurn);
1828 if GTestFlags and tfImmAdvance <> 0 then
1829 Research := Cost;
1830 if (Happened and phTech = 0) and (Research >= Cost) then
1831 begin
1832 if ResearchTech = adMilitary then
1833 EnableDevModel(pTurn) { new Unit class initiated }
1834 else if ResearchTech >= 0 then
1835 DiscoverTech(pTurn, ResearchTech);
1836
1837 dec(Research, Cost);
1838 Happened := Happened or phTech;
1839 ResearchTech := -1
1840 end
1841 else if (ResearchTech = -2) and (nCity > 0) then
1842 begin
1843 Happened := Happened or phTech;
1844 ResearchTech := -1
1845 end;
1846
1847 if Credibility < MaxCredibility then
1848 for p1 := 0 to nPl - 1 do
1849 if (p1 <> pTurn) and (1 shl p1 and GAlive <> 0) and
1850 (Treaty[p1] >= trPeace) then
1851 begin
1852 inc(Credibility);
1853 Break
1854 end;
1855
1856 if GWinner = 0 then
1857 CheckWin(pTurn);
1858 if (Mode >= moMovie) and (GWinner = 0) and
1859 ((ShowShipChange.Ship1Change[0] > 0) or
1860 (ShowShipChange.Ship1Change[1] > 0) or
1861 (ShowShipChange.Ship1Change[2] > 0)) then
1862 begin
1863 ShowShipChange.Reason := scrProduction;
1864 ShowShipChange.Ship1Owner := pTurn;
1865 ShowShipChange.Ship2Owner := -1;
1866 for p1 := 0 to nPl - 1 do
1867 if (p1 <> pTurn) and (1 shl p1 and (GAlive or GWatching) <> 0) then
1868 begin
1869 move(GShip, RW[p1].Ship, SizeOf(GShip));
1870 if 1 shl p1 and GWatching <> 0 then
1871 CallPlayer(cShowShipChange, p1, ShowShipChange);
1872 end
1873 end;
1874 if WinOnAlone and (GAlive and not(1 shl pTurn or 1) = 0) then
1875 GWinner := 1 shl pTurn; // break if only one nation left
1876
1877 if GTurn = AnarchyStart + AnarchyTurns then
1878 begin
1879 AnarchyStart := -AnarchyTurns - 1;
1880 Government := gDespotism;
1881 for p1 := 0 to nPl - 1 do
1882 if (p1 <> pTurn) and ((GAlive or GWatching) and (1 shl p1) <> 0) then
1883 RW[p1].EnemyReport[pTurn].Government := gDespotism;
1884 inc(Happened, phChangeGov)
1885 end;
1886 end; // if Difficulty[pTurn]>0
1887
1888 if (pTurn = 0) and (GWinner > 0) then
1889 begin // game over, give world map and all reports to player 0
1890 DiscoverAll(pTurn, lObserveSuper);
1891 for p1 := 1 to nPl - 1 do
1892 if 1 shl p1 and GAlive <> 0 then
1893 begin
1894 if RW[pTurn].Treaty[p1] < trNone then
1895 begin
1896 RW[pTurn].Treaty[p1] := trNone;
1897 RW[p1].Treaty[pTurn] := trNone;
1898 end;
1899 GiveCivilReport(pTurn, p1);
1900 GiveMilReport(pTurn, p1);
1901 end;
1902 end
1903 else
1904 begin
1905 // show observed areas
1906 if (GTestFlags and tfUncover <> 0) or (Difficulty[pTurn] = 0)
1907 then { supervisor - all tiles visible }
1908 begin
1909 if (bix[pTurn].Kind <> btNoTerm) and
1910 ((Difficulty[pTurn] > 0) or (Mode > moLoading_Fast)) then
1911 DiscoverAll(pTurn, lObserveSuper)
1912 end
1913 else
1914 begin
1915 DiscoverViewAreas(pTurn);
1916 if MirBuilt then
1917 DiscoverAll(pTurn, lObserveUnhidden)
1918 end
1919 end;
1920 // CheckContact;
1921end; { BeforeTurn }
1922
1923procedure AfterTurn;
1924var
1925 cix, uix, p1, Loc1, Job0: integer;
1926 JobDone: boolean;
1927begin
1928 with RW[pTurn] do
1929 begin
1930 for cix := 0 to nCity - 1 do
1931 if City[cix].Loc >= 0 then
1932 begin
1933 // City[cix].Flags:=City[cix].Flags and not chProductionSabotaged;
1934 City[cix].Flags := City[cix].Flags and (chCaptured or chDisorder);
1935 CollectCityResources(pTurn, cix); // new style
1936 end;
1937
1938 inc(Money, OracleIncome);
1939 OracleIncome := 0;
1940 if GWonder[woOracle].EffectiveOwner = pTurn then
1941 begin
1942 for p1 := 0 to nPl - 1 do
1943 if (1 shl p1 and GAlive <> 0) and
1944 ((p1 = pTurn) or (RW[pTurn].Treaty[p1] > trNoContact)) then
1945 for cix := 0 to RW[p1].nCity - 1 do
1946 if (RW[p1].City[cix].Loc >= 0) and
1947 (RW[p1].City[cix].built[imTemple] > 0) then
1948 inc(OracleIncome);
1949 end;
1950
1951 if (GTestFlags and tfImmImprove = 0) and (Government <> gAnarchy) then
1952 for cix := 0 to nCity - 1 do
1953 if (City[cix].Loc >= 0) and (City[cix].Flags and chCaptured = 0) then
1954 PayCityMaintenance(pTurn, cix);
1955
1956 if ServerVersion[pTurn] >= $000EF0 then
1957 begin // let settlers work
1958 for cix := 0 to nCity - 1 do
1959 City[cix].Flags := City[cix].Flags and not chFounded;
1960 for uix := 0 to nUn - 1 do
1961 with Un[uix] do
1962 if Loc >= 0 then
1963 begin
1964 Loc1 := Loc;
1965 Job0 := Job;
1966 if Job <> jNone then
1967 JobDone := Work(pTurn, uix);
1968 { settlers do terrain improvement jobs }
1969 if Health <= 0 then
1970 RemoveUnit_UpdateMap(pTurn, uix);
1971
1972 if (Job0 = jCity) and JobDone then // new city
1973 begin
1974 AddBestCityTile(pTurn, RW[pTurn].nCity - 1);
1975 UpdateUnitMap(Loc1, true);
1976 if Mode >= moMovie then // tell enemies
1977 for p1 := 0 to nPl - 1 do
1978 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) and
1979 (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then
1980 CallPlayer(cShowCityChanged, p1, Loc1);
1981 end
1982 end;
1983 end;
1984
1985 for uix := 0 to nUn - 1 do
1986 with Un[uix] do
1987 if Loc >= 0 then
1988 begin { next turn for all units }
1989 if Model[mix].Domain = dAir then
1990 if (Master >= 0) or (RealMap[Loc] and fCity <> 0) or
1991 (RealMap[Loc] and fTerImp = tiBase) then
1992 begin
1993 Fuel := Model[mix].Cap[mcFuel];
1994 Flags := Flags or unBombsLoaded
1995 end
1996 else if Model[mix].Kind = mkSpecial_Glider then { glider }
1997 begin
1998 if RealMap[Loc] and fTerrain < fGrass then
1999 begin
2000 RemoveUnit_UpdateMap(pTurn, uix); // unit lost
2001 Happened := Happened or phGliderLost
2002 end
2003 end
2004 else
2005 begin
2006 dec(Fuel);
2007 if Fuel < 0 then
2008 begin
2009 RemoveUnit_UpdateMap(pTurn, uix); // unit lost
2010 Happened := Happened or phPlaneLost
2011 end
2012 end
2013 else if (Master < 0) and (Movement > 0) then // check HostileDamage
2014 begin
2015 Health := Health - HostileDamage(pTurn, mix, Loc, Movement);
2016 if Health < 0 then
2017 RemoveUnit_UpdateMap(pTurn, uix);
2018 end
2019 end; { unit loop 1 }
2020
2021 for uix := 0 to nUn - 1 do
2022 with Un[uix] do
2023 begin
2024 Flags := Flags and not unWithdrawn;
2025 if (Loc >= 0) and (Model[mix].Domain = dGround) and (Master < 0) and
2026 ((integer(Movement) = Model[mix].Speed) or
2027 (Model[mix].Cap[mcAcademy] > 0) and (Movement * 2 >= Model[mix].Speed))
2028 then
2029 Flags := Flags or unFortified; // fortify unmoved units
2030 end;
2031
2032 if (GTestFlags and tfUncover = 0) and (Difficulty[pTurn] > 0) then
2033 begin // restrict view area to current positions
2034 MaskD(ObserveLevel, MapSize, not Cardinal(3 shl (2 * pTurn)));
2035 if Mode > moLoading_Fast then
2036 MaskD(RW[pTurn].Map^, MapSize, Cardinal(not Cardinal(fUnit or fHiddenUnit or
2037 fStealthUnit or fObserved or fSpiedOut or fOwned or fOwnZoCUnit or
2038 fInEnemyZoC)));
2039 RW[pTurn].nEnemyUn := 0;
2040 DiscoverViewAreas(pTurn);
2041 end;
2042
2043 if GWinner = 0 then
2044 for p1 := 0 to nPl - 1 do
2045 if 1 shl p1 and GAlive <> 0 then
2046 CheckWin(p1);
2047 end;
2048end; // Afterturn
2049
2050procedure NextPlayer;
2051begin
2052 if GTurn = 0 then
2053 BeforeTurn0
2054 else
2055 BeforeTurn;
2056 NoLogCityTileChanges;
2057 GenerateStat(pTurn);
2058 Inform(pTurn);
2059 ChangeClient;
2060end;
2061
2062function ExecuteMove(p, uix, ToLoc: integer; var MoveInfo: TMoveInfo;
2063 ShowMove: TShowMove): integer;
2064var
2065 i, p1, FromLoc, uix1, nUpdateLoc: integer;
2066 MinLevel, MissionResult: Cardinal;
2067 PModel: ^TModel;
2068 UpdateLoc: array [0 .. numax - 1] of integer;
2069 SeeFrom, SeeTo, ExtDiscover: boolean;
2070begin
2071 result := 0;
2072 with RW[p], Un[uix] do
2073 begin
2074 PModel := @Model[mix];
2075 FromLoc := Loc;
2076
2077 if Master < 0 then
2078 FreeUnit(p, uix);
2079 if (MoveInfo.MoveType in [mtMove, mtCapture]) and MoveInfo.MountainDelay
2080 then
2081 begin
2082 Flags := Flags or unMountainDelay;
2083 end;
2084 Loc := -2;
2085 if TroopLoad + AirLoad > 0 then
2086 for i := 0 to nUn - 1 do
2087 if (Un[i].Loc >= 0) and (Un[i].Master = uix) then
2088 Un[i].Loc := -2;
2089 UpdateUnitMap(FromLoc);
2090
2091 if Mode >= moMovie then { show move in interface modules }
2092 begin
2093 ShowMove.EndHealth := MoveInfo.EndHealth;
2094 ShowMove.EndHealthDef := -1;
2095 if Master >= 0 then
2096 if Model[Un[Master].mix].Domain = dAir then
2097 ShowMove.Flags := ShowMove.Flags or umPlaneUnloading
2098 else
2099 ShowMove.Flags := ShowMove.Flags or umShipUnloading;
2100 if MoveInfo.ToMaster >= 0 then
2101 if Model[Un[MoveInfo.ToMaster].mix].Domain = dAir then
2102 ShowMove.Flags := ShowMove.Flags or umPlaneLoading
2103 else
2104 ShowMove.Flags := ShowMove.Flags or umShipLoading;
2105 for p1 := 0 to nPl - 1 do
2106 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1].Kind = btTerm))
2107 then
2108 begin
2109 if PModel.Cap[mcStealth] > 0 then
2110 MinLevel := lObserveSuper
2111 else if PModel.Cap[mcSub] > 0 then
2112 MinLevel := lObserveAll
2113 else
2114 MinLevel := lObserveUnhidden;
2115 SeeFrom := (p1 = p) or (ObserveLevel[FromLoc] shr (2 * p1) and
2116 3 >= MinLevel);
2117 SeeTo := (p1 = p) or (ObserveLevel[ToLoc] shr (2 * p1) and
2118 3 >= MinLevel);
2119 if SeeFrom and SeeTo then
2120 begin
2121 TellAboutModel(p1, p, mix);
2122 if p1 = p then
2123 ShowMove.emix := -1
2124 else
2125 ShowMove.emix := emixSafe(p1, p, mix);
2126 if MoveInfo.MoveType = mtCapture then
2127 CallPlayer(cShowCapturing, p1, ShowMove)
2128 else
2129 CallPlayer(cShowMoving, p1, ShowMove);
2130 end
2131 else if SeeFrom then
2132 CallPlayer(cShowUnitChanged, p1, FromLoc);
2133 end;
2134 end;
2135
2136 if MoveInfo.MoveType <> mtSpyMission then
2137 Loc := ToLoc;
2138 if TroopLoad + AirLoad > 0 then
2139 for i := 0 to nUn - 1 do
2140 if Un[i].Loc = -2 then
2141 Un[i].Loc := ToLoc;
2142
2143 ExtDiscover := false;
2144 nUpdateLoc := 0;
2145 if MoveInfo.MoveType = mtCapture then
2146 begin
2147 assert(Occupant[ToLoc] < 0);
2148 for uix1 := 0 to RW[MoveInfo.Defender].nUn - 1 do
2149 with RW[MoveInfo.Defender].Un[uix1] do
2150 if (Loc >= 0) and (Home = MoveInfo.Dcix) then
2151 begin
2152 UpdateLoc[nUpdateLoc] := Loc;
2153 inc(nUpdateLoc)
2154 end;
2155 // unit will be removed -- remember position and update for all players
2156
2157 if (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size > 2) and (nCity < ncmax)
2158 then
2159 begin // city captured
2160 ChangeCityOwner_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, p);
2161 City[nCity - 1].Flags := CaptureTurns shl 16;
2162 CityShrink(p, nCity - 1);
2163 if Mode = moPlaying then
2164 with RW[p].City[nCity - 1] do
2165 begin
2166 // SavedResourceWeights[nCity-1]:=ResourceWeights;
2167 SavedTiles[nCity - 1] := Tiles;
2168 end;
2169 ExtDiscover := true;
2170
2171 // Temple of Zeus effect
2172 if GWonder[woZeus].EffectiveOwner = p then
2173 begin
2174 GiveCivilReport(p, MoveInfo.Defender);
2175 for i := 0 to nAdv - 1 do
2176 if not(i in FutureTech) and (RW[p].Tech[i] < tsSeen) and
2177 (RW[MoveInfo.Defender].Tech[i] >= tsApplicable) then
2178 begin
2179 Happened := Happened or phStealTech;
2180 GStealFrom := MoveInfo.Defender;
2181 Break
2182 end
2183 end;
2184 if Mode = moPlaying then
2185 LogCheckBorders(p, nCity - 1, MoveInfo.Defender);
2186{$IFOPT O-} if Mode < moPlaying then
2187 InvalidTreatyMap := not(1 shl p); {$ENDIF}
2188 // territory should not be considered for the rest of the command
2189 // execution, because during loading a game it's incorrect before
2190 // subsequent sIntExpandTerritory is processed
2191 end
2192 else // city destroyed
2193 begin
2194 DestroyCity_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, false);
2195 CheckBorders(ToLoc, MoveInfo.Defender);
2196 end;
2197 RecalcPeaceMap(p);
2198 if Mode >= moMovie then
2199 move(GWonder, Wonder, SizeOf(GWonder));
2200 end; { if MoveInfo.MoveType=mtCapture }
2201
2202 if MoveInfo.MoveType = mtSpyMission then
2203 begin
2204 MissionResult := DoSpyMission(p, MoveInfo.Defender, MoveInfo.Dcix,
2205 SpyMission);
2206 if (Mode = moPlaying) and (SpyMission = smStealForeignReports) then
2207 CallPlayer(cShowMissionResult, p, MissionResult);
2208 end;
2209
2210 Health := MoveInfo.EndHealth;
2211 dec(Movement, MoveInfo.Cost);
2212 // transport unload
2213 if Master >= 0 then
2214 begin
2215 if PModel.Domain = dAir then
2216 dec(Un[Master].AirLoad)
2217 else
2218 begin
2219 dec(Un[Master].TroopLoad);
2220 assert(Movement <= 0);
2221 end;
2222 Master := -1;
2223 end;
2224
2225 if (Health <= 0) or (MoveInfo.MoveType = mtSpyMission) then
2226 RemoveUnit(p, uix) // spy mission or victim of HostileDamage
2227 else
2228 begin // transport load
2229 Master := MoveInfo.ToMaster;
2230 if MoveInfo.ToMaster >= 0 then
2231 begin
2232 if PModel.Domain = dAir then
2233 inc(Un[MoveInfo.ToMaster].AirLoad)
2234 else
2235 inc(Un[MoveInfo.ToMaster].TroopLoad);
2236 end
2237 else
2238 PlaceUnit(p, uix);
2239 end;
2240
2241 if (MoveInfo.MoveType = mtCapture) and (nUpdateLoc > 0) then
2242 RecalcMapZoC(p);
2243 UpdateUnitMap(ToLoc, MoveInfo.MoveType = mtCapture);
2244 for i := 0 to nUpdateLoc - 1 do
2245 UpdateUnitMap(UpdateLoc[i]);
2246 // tell about lost units of defender
2247
2248 if (MoveInfo.MoveType <> mtSpyMission) and (Master < 0) then
2249 begin
2250 if (PModel.Kind = mkDiplomat) or (PModel.Domain = dAir) or
2251 (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] + PModel.Cap[mcAcademy] >
2252 0) or (RealMap[ToLoc] and fTerrain = fMountains) or
2253 (RealMap[ToLoc] and fTerImp = tiFort) or
2254 (RealMap[ToLoc] and fTerImp = tiBase) then
2255 ExtDiscover := true;
2256 if (PModel.Kind = mkDiplomat) or (PModel.Cap[mcSpy] > 0) then
2257 i := lObserveSuper
2258 else if (PModel.Domain = dAir) or
2259 (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] > 0) then
2260 i := lObserveAll
2261 else
2262 i := lObserveUnhidden;
2263 if ExtDiscover then
2264 begin
2265 if Discover21(ToLoc, p, i, true, PModel.Domain = dGround) then
2266 result := result or rEnemySpotted;
2267 end
2268 else
2269 begin
2270 if Discover9(ToLoc, p, i, true, PModel.Domain = dGround) then
2271 result := result or rEnemySpotted;
2272 end;
2273 end;
2274
2275 if Mode >= moMovie then { show after-move in interface modules }
2276 for p1 := 0 to nPl - 1 do
2277 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1].Kind = btTerm))
2278 then
2279 begin
2280 if PModel.Cap[mcStealth] > 0 then
2281 MinLevel := lObserveSuper
2282 else if PModel.Cap[mcSub] > 0 then
2283 MinLevel := lObserveAll
2284 else
2285 MinLevel := lObserveUnhidden;
2286 SeeFrom := (p1 = p) or (ObserveLevel[FromLoc] shr (2 * p1) and
2287 3 >= MinLevel);
2288 SeeTo := (p1 = p) or (ObserveLevel[ToLoc] shr (2 * p1) and
2289 3 >= MinLevel);
2290 if SeeTo and (MoveInfo.MoveType = mtCapture) then
2291 CallPlayer(cShowCityChanged, p1, ToLoc);
2292 if SeeFrom and SeeTo then
2293 CallPlayer(cShowAfterMove, p1, ToLoc)
2294 else if (MoveInfo.MoveType <> mtSpyMission) and SeeTo then
2295 CallPlayer(cShowUnitChanged, p1, ToLoc);
2296 for i := 0 to nUpdateLoc - 1 do
2297 if ObserveLevel[UpdateLoc[i]] shr (2 * p1) and 3 >= lObserveUnhidden
2298 then
2299 CallPlayer(cShowUnitChanged, p1, UpdateLoc[i]);
2300 end;
2301 end;
2302end; // ExecuteMove
2303
2304function ExecuteAttack(p, uix, ToLoc: integer; var MoveInfo: TMoveInfo;
2305 ShowMove: TShowMove): integer;
2306
2307 procedure WriteBattleHistory(ToLoc, FromLoc, Attacker, Defender, mixAttacker,
2308 mixDefender: integer; AttackerLost, DefenderLost: boolean);
2309 var
2310 AttackerBattle, DefenderBattle: ^TBattle;
2311 begin
2312 with RW[Attacker] do
2313 begin
2314 if nBattleHistory = 0 then
2315 ReallocMem(BattleHistory, 16 * SizeOf(TBattle))
2316 else if (nBattleHistory >= 16) and
2317 (nBattleHistory and (nBattleHistory - 1) = 0) then
2318 ReallocMem(BattleHistory, nBattleHistory * (2 * SizeOf(TBattle)));
2319 AttackerBattle := @BattleHistory[nBattleHistory];
2320 inc(nBattleHistory);
2321 end;
2322 with RW[Defender] do
2323 begin
2324 if nBattleHistory = 0 then
2325 ReallocMem(BattleHistory, 16 * SizeOf(TBattle))
2326 else if (nBattleHistory >= 16) and
2327 (nBattleHistory and (nBattleHistory - 1) = 0) then
2328 ReallocMem(BattleHistory, nBattleHistory * (2 * SizeOf(TBattle)));
2329 DefenderBattle := @BattleHistory[nBattleHistory];
2330 inc(nBattleHistory);
2331 end;
2332 AttackerBattle.Enemy := Defender;
2333 AttackerBattle.Flags := 0;
2334 AttackerBattle.Turn := GTurn;
2335 AttackerBattle.mix := mixAttacker;
2336 AttackerBattle.mixEnemy := mixDefender;
2337 AttackerBattle.ToLoc := ToLoc;
2338 AttackerBattle.FromLoc := FromLoc;
2339 DefenderBattle.Enemy := Attacker;
2340 DefenderBattle.Flags := bhEnemyAttack;
2341 DefenderBattle.Turn := GTurn;
2342 DefenderBattle.mix := mixDefender;
2343 DefenderBattle.mixEnemy := mixAttacker;
2344 DefenderBattle.ToLoc := ToLoc;
2345 DefenderBattle.FromLoc := FromLoc;
2346 if AttackerLost then
2347 begin
2348 AttackerBattle.Flags := AttackerBattle.Flags or bhMyUnitLost;
2349 DefenderBattle.Flags := DefenderBattle.Flags or bhEnemyUnitLost;
2350 end;
2351 if DefenderLost then
2352 begin
2353 AttackerBattle.Flags := AttackerBattle.Flags or bhEnemyUnitLost;
2354 DefenderBattle.Flags := DefenderBattle.Flags or bhMyUnitLost;
2355 end;
2356 end;
2357
2358var
2359 i, p1, FromLoc, uix1, nUpdateLoc, ExpGain, ExpelToLoc, cix1: integer;
2360 PModel: ^TModel;
2361 UpdateLoc: array [0 .. numax - 1] of integer;
2362 LoseCityPop, CityDestroyed, SeeFrom, SeeTo, ZoCDefenderDestroyed: boolean;
2363begin
2364 result := 0;
2365 with RW[p].Un[uix] do
2366 begin
2367 PModel := @RW[p].Model[mix];
2368 FromLoc := Loc;
2369
2370 ShowMove.EndHealth := MoveInfo.EndHealth;
2371 ShowMove.EndHealthDef := MoveInfo.EndHealthDef;
2372 if MoveInfo.MoveType = mtAttack then
2373 WriteBattleHistory(ToLoc, FromLoc, p, MoveInfo.Defender, mix,
2374 RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix, MoveInfo.EndHealth <= 0,
2375 MoveInfo.EndHealthDef <= 0);
2376
2377 { if RW[p].Treaty[MoveInfo.Defender]=trCeaseFire then
2378 begin
2379 if Mode>=moMovie then
2380 CallPlayer(cShowCancelTreaty,MoveInfo.Defender,p);
2381 CancelTreaty(p,MoveInfo.Defender)
2382 end; }
2383 if Mode >= moMovie then { show attack in interface modules }
2384 for p1 := 0 to nPl - 1 do
2385 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1].Kind = btTerm))
2386 then
2387 begin
2388 SeeFrom := ObserveLevel[FromLoc] shr (2 * p1) and
2389 3 >= lObserveUnhidden;
2390 SeeTo := ObserveLevel[ToLoc] shr (2 * p1) and 3 >= lObserveUnhidden;
2391 if SeeFrom and SeeTo then
2392 begin
2393 TellAboutModel(p1, p, mix);
2394 if p1 = p then
2395 ShowMove.emix := -1
2396 else
2397 ShowMove.emix := emixSafe(p1, p, mix);
2398 CallPlayer(cShowAttacking, p1, ShowMove);
2399 end;
2400 end;
2401
2402 LoseCityPop := false;
2403 if (RealMap[ToLoc] and fCity <> 0) and
2404 ((MoveInfo.MoveType = mtAttack) and (MoveInfo.EndHealthDef <= 0) or
2405 (MoveInfo.MoveType = mtBombard) and (BombardmentDestroysCity or
2406 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size > 2))) then
2407 case PModel.Domain of
2408 dGround:
2409 LoseCityPop := (PModel.Cap[mcArtillery] > 0) or
2410 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].built[imWalls] = 0) and
2411 (Continent[ToLoc] <> GrWallContinent[MoveInfo.Defender]);
2412 dSea:
2413 LoseCityPop := RW[MoveInfo.Defender].City[MoveInfo.Dcix].built
2414 [imCoastalFort] = 0;
2415 dAir:
2416 LoseCityPop := RW[MoveInfo.Defender].City[MoveInfo.Dcix].built
2417 [imMissileBat] = 0;
2418 end;
2419 CityDestroyed := LoseCityPop and
2420 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size <= 2);
2421
2422 if MoveInfo.MoveType = mtBombard then
2423 begin
2424 assert(Movement >= 100);
2425 if PModel.Attack = 0 then
2426 Flags := Flags and not unBombsLoaded;
2427 dec(Movement, 100)
2428 end
2429 else if MoveInfo.MoveType = mtExpel then
2430 begin
2431 assert(Movement >= 100);
2432 Job := jNone;
2433 Flags := Flags and not unFortified;
2434 dec(Movement, 100)
2435 end
2436 else
2437 begin
2438 assert(MoveInfo.MoveType = mtAttack);
2439 if MoveInfo.EndHealth = 0 then
2440 RemoveUnit(p, uix, MoveInfo.Defender) // destroy attacker
2441 else
2442 begin // update attacker
2443 ExpGain := (Health - MoveInfo.EndHealth + 1) shr 1;
2444 if Exp + ExpGain > (nExp - 1) * ExpCost then
2445 Exp := (nExp - 1) * ExpCost
2446 else
2447 inc(Exp, ExpGain);
2448 Health := MoveInfo.EndHealth;
2449 Job := jNone;
2450 if RW[MoveInfo.Defender].Model[RW[MoveInfo.Defender].Un[MoveInfo.Duix]
2451 .mix].Domain < dAir then
2452 Flags := Flags and not unBombsLoaded;
2453 Flags := Flags and not unFortified;
2454 if Movement > 100 then
2455 dec(Movement, 100)
2456 else
2457 Movement := 0;
2458 end;
2459 end;
2460
2461 ZoCDefenderDestroyed := false;
2462 nUpdateLoc := 0;
2463 if MoveInfo.MoveType = mtExpel then
2464 with RW[MoveInfo.Defender], Un[MoveInfo.Duix] do
2465 begin // expel friendly unit
2466 if Home >= 0 then
2467 ExpelToLoc := City[Home].Loc
2468 else
2469 begin
2470 ExpelToLoc := City[0].Loc; // search destination for homeless units
2471 for cix1 := 1 to nCity - 1 do
2472 if (City[cix1].Loc >= 0) and
2473 ((ExpelToLoc < 0) or (City[cix1].built[imPalace] > 0)) then
2474 ExpelToLoc := City[cix1].Loc;
2475 end;
2476 if ExpelToLoc >= 0 then
2477 begin
2478 FreeUnit(MoveInfo.Defender, MoveInfo.Duix);
2479 Loc := ExpelToLoc;
2480 PlaceUnit(MoveInfo.Defender, MoveInfo.Duix);
2481 UpdateLoc[nUpdateLoc] := Loc;
2482 inc(nUpdateLoc);
2483 Flags := Flags or unWithdrawn;
2484 end
2485 end
2486 else if (MoveInfo.MoveType = mtAttack) and (MoveInfo.EndHealthDef > 0) then
2487 with RW[MoveInfo.Defender].Un[MoveInfo.Duix] do
2488 begin // update defender
2489 ExpGain := (Health - MoveInfo.EndHealthDef + 1) shr 1;
2490 if Exp + ExpGain > (nExp - 1) * ExpCost then
2491 Exp := (nExp - 1) * ExpCost
2492 else
2493 inc(Exp, ExpGain);
2494 Health := MoveInfo.EndHealthDef;
2495 end
2496 else
2497 begin // destroy defenders
2498 if MoveInfo.MoveType <> mtBombard then
2499 begin
2500 ZoCDefenderDestroyed := RW[MoveInfo.Defender].Model
2501 [RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix].Flags and mdZOC <> 0;
2502 if ((RealMap[ToLoc] and fCity = 0) and
2503 (RealMap[ToLoc] and fTerImp <> tiBase) and
2504 (RealMap[ToLoc] and fTerImp <> tiFort)) or LoseCityPop and
2505 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size = 2) then
2506 RemoveAllUnits(MoveInfo.Defender, ToLoc, p)
2507 { no city, base or fortress }
2508 else
2509 RemoveUnit(MoveInfo.Defender, MoveInfo.Duix, p);
2510 end;
2511
2512 if LoseCityPop then // city defender defeated -- shrink city
2513 if not CityDestroyed then
2514 CityShrink(MoveInfo.Defender, MoveInfo.Dcix)
2515 else
2516 begin
2517 for uix1 := 0 to RW[MoveInfo.Defender].nUn - 1 do
2518 with RW[MoveInfo.Defender].Un[uix1] do
2519 if (Loc >= 0) and (Home = MoveInfo.Dcix) then
2520 begin
2521 UpdateLoc[nUpdateLoc] := Loc;
2522 inc(nUpdateLoc)
2523 end;
2524 // unit will be removed -- remember position and update for all players
2525 DestroyCity_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, false);
2526 CheckBorders(ToLoc, MoveInfo.Defender);
2527 RecalcPeaceMap(p);
2528 end;
2529 end;
2530
2531 if CityDestroyed and (nUpdateLoc > 0) then
2532 RecalcMapZoC(p)
2533 else if ZoCDefenderDestroyed then
2534 RecalcV8ZoC(p, ToLoc);
2535 UpdateUnitMap(FromLoc);
2536 UpdateUnitMap(ToLoc, LoseCityPop);
2537 for i := 0 to nUpdateLoc - 1 do
2538 UpdateUnitMap(UpdateLoc[i]);
2539 // tell about lost units of defender
2540
2541 if Mode >= moMovie then
2542 begin
2543 for i := 0 to RW[p].nEnemyModel - 1 do
2544 with RW[p].EnemyModel[i] do
2545 Lost := Destroyed[p, Owner, mix];
2546 for p1 := 0 to nPl - 1 do { show after-attack in interface modules }
2547 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1].Kind = btTerm))
2548 then
2549 begin
2550 SeeFrom := ObserveLevel[FromLoc] shr (2 * p1) and
2551 3 >= lObserveUnhidden;
2552 SeeTo := ObserveLevel[ToLoc] shr (2 * p1) and 3 >= lObserveUnhidden;
2553 if SeeTo and CityDestroyed then
2554 CallPlayer(cShowCityChanged, p1, ToLoc); // city was destroyed
2555 if SeeFrom and SeeTo then
2556 begin
2557 CallPlayer(cShowAfterAttack, p1, ToLoc);
2558 CallPlayer(cShowAfterAttack, p1, FromLoc);
2559 end
2560 else
2561 begin
2562 if SeeTo then
2563 CallPlayer(cShowUnitChanged, p1, ToLoc);
2564 if SeeFrom then
2565 CallPlayer(cShowUnitChanged, p1, FromLoc);
2566 end;
2567 if SeeTo and (MoveInfo.MoveType = mtExpel) and (ExpelToLoc >= 0) then
2568 CallPlayer(cShowUnitChanged, p1, ExpelToLoc);
2569 end;
2570 end
2571 end
2572end; // ExecuteAttack
2573
2574function MoveUnit(p, uix, dx, dy: integer; TestOnly: boolean): integer;
2575var
2576 ToLoc: integer;
2577 MoveInfo: TMoveInfo;
2578 ShowMove: TShowMove;
2579begin
2580{$IFOPT O-}assert(1 shl p and InvalidTreatyMap = 0); {$ENDIF}
2581 with RW[p].Un[uix] do
2582 begin
2583 ToLoc := dLoc(Loc, dx, dy);
2584 if (ToLoc < 0) or (ToLoc >= MapSize) then
2585 begin
2586 result := eInvalid;
2587 exit
2588 end;
2589 result := CalculateMove(p, uix, ToLoc, 3 - dy and 1, TestOnly, MoveInfo);
2590 if result = eZOC_EnemySpotted then
2591 ZOCTile := ToLoc;
2592 if (result >= rExecuted) and not TestOnly then
2593 begin
2594 ShowMove.dx := dx;
2595 ShowMove.dy := dy;
2596 ShowMove.FromLoc := Loc;
2597 ShowMove.mix := mix;
2598 ShowMove.Health := Health;
2599 ShowMove.Fuel := Fuel;
2600 ShowMove.Exp := Exp;
2601 ShowMove.Load := TroopLoad + AirLoad;
2602 ShowMove.Owner := p;
2603 if (TroopLoad > 0) or (AirLoad > 0) then
2604 ShowMove.Flags := unMulti
2605 else
2606 ShowMove.Flags := 0;
2607 case MoveInfo.MoveType of
2608 mtCapture:
2609 ShowMove.Flags := ShowMove.Flags or umCapturing;
2610 mtSpyMission:
2611 ShowMove.Flags := ShowMove.Flags or umSpyMission;
2612 mtBombard:
2613 ShowMove.Flags := ShowMove.Flags or umBombarding;
2614 mtExpel:
2615 ShowMove.Flags := ShowMove.Flags or umExpelling;
2616 end;
2617 case MoveInfo.MoveType of
2618 mtMove, mtCapture, mtSpyMission:
2619 result := ExecuteMove(p, uix, ToLoc, MoveInfo, ShowMove) or result;
2620 mtAttack, mtBombard, mtExpel:
2621 result := ExecuteAttack(p, uix, ToLoc, MoveInfo, ShowMove) or result
2622 end;
2623 end
2624 end; // with
2625end; { MoveUnit }
2626
2627function Server(Command, Player, Subject: integer; var Data): integer; stdcall;
2628
2629 function CountPrice(const Offer: TOffer; PriceType: integer): integer;
2630 var
2631 i: integer;
2632 begin
2633 result := 0;
2634 for i := 0 to Offer.nDeliver + Offer.nCost - 1 do
2635 if Offer.Price[i] and $FFFF0000 = Cardinal(PriceType) then
2636 inc(result);
2637 end;
2638
2639{ procedure UpdateBorderHelper;
2640 var
2641 x, y, Loc, Loc1, dx, dy, ObserveMask: integer;
2642 begin
2643 ObserveMask:=3 shl (2*pTurn);
2644 for x:=0 to lx-1 do for y:=0 to ly shr 1-1 do
2645 begin
2646 Loc:=lx*(y*2)+x;
2647 if ObserveLevel[Loc] and ObserveMask<>0 then
2648 begin
2649 for dy:=0 to 1 do for dx:=0 to 1 do
2650 begin
2651 Loc1:=(Loc+dx-1+lx) mod lx +lx*((y+dy)*2-1);
2652 if (Loc1>=0) and (Loc1<MapSize)
2653 and (ObserveLevel[Loc1] and ObserveMask<>0) then
2654 if RealMap[Loc1] and $78000000=RealMap[Loc] and $78000000 then
2655 begin
2656 RW[pTurn].BorderHelper[Loc]:=RW[pTurn].BorderHelper[Loc] and not (1 shl (dy*2+dx));
2657 RW[pTurn].BorderHelper[Loc1]:=RW[pTurn].BorderHelper[Loc1] and not (8 shr (dy*2+dx))
2658 end
2659 else
2660 begin
2661 RW[pTurn].BorderHelper[Loc]:=RW[pTurn].BorderHelper[Loc] or (1 shl (dy*2+dx));
2662 RW[pTurn].BorderHelper[Loc1]:=RW[pTurn].BorderHelper[Loc1] or (8 shr (dy*2+dx));
2663 end
2664 end
2665 end
2666 end
2667 end; }
2668
2669const
2670 ptSelect = 0;
2671 ptTrGoods = 1;
2672 ptUn = 2;
2673 ptCaravan = 3;
2674 ptImp = 4;
2675 ptWonder = 6;
2676 ptShip = 7;
2677 ptInvalid = 8;
2678
2679 function ProjectType(Project: integer): integer;
2680 begin
2681 if Project and cpCompleted <> 0 then
2682 result := ptSelect
2683 else if Project and (cpImp + cpIndex) = cpImp + imTrGoods then
2684 result := ptTrGoods
2685 else if Project and cpImp = 0 then
2686 if RW[Player].Model[Project and cpIndex].Kind = mkCaravan then
2687 result := ptCaravan
2688 else
2689 result := ptUn
2690 else if Project and cpIndex >= nImp then
2691 result := ptInvalid
2692 else if Imp[Project and cpIndex].Kind = ikWonder then
2693 result := ptWonder
2694 else if Imp[Project and cpIndex].Kind = ikShipPart then
2695 result := ptShip
2696 else
2697 result := ptImp
2698 end;
2699
2700const
2701 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0);
2702 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2);
2703
2704var
2705 d, i, j, p1, p2, pt0, pt1, uix1, cix1, Loc0, Loc1, dx, dy, NewCap, MinCap,
2706 MaxCap, CapWeight, Cost, NextProd, Preq, TotalFood, TotalProd, CheckSum,
2707 StopTurn, FutureMCost, NewProject, OldImp, mix, V8, V21, AStr, DStr,
2708 ABaseDamage, DBaseDamage: integer;
2709 CityReport, AltCityReport: TCityReport;
2710 FormerCLState: TCmdListState;
2711 EndTime: int64;
2712 Adjacent: TVicinity8Loc;
2713 Radius: TVicinity21Loc;
2714 ShowShipChange: TShowShipChange;
2715 ShowNegoData: TShowNegoData;
2716 logged, ok, HasShipChanged, AllHumansDead, OfferFullySupported: boolean;
2717
2718begin { >>>server }
2719 if Command = sTurn then
2720 begin
2721 p2 := -1;
2722 for p1 := 0 to nPl - 1 do
2723 if (p1 <> Player) and (1 shl p1 and GWatching <> 0) then
2724 CallPlayer(cShowTurnChange, p1, p2);
2725 end;
2726
2727 assert(MapSize = lx * ly);
2728 assert(Command and (sctMask or sExecute) <> sctInternal or sExecute);
2729 // not for internal commands
2730 if (Command < 0) or (Command >= $10000) then
2731 begin
2732 result := eUnknown;
2733 exit
2734 end;
2735
2736 if (Player < 0) or (Player >= nPl) or
2737 ((Command and (sctMask or sExecute) <> sctInfo) and
2738 ((Subject < 0) or (Subject >= $1000))) then
2739 begin
2740 result := eInvalid;
2741 exit
2742 end;
2743
2744 if (1 shl Player and (GAlive or GWatching) = 0) and
2745 not((Command = sTurn) or (Command = sBreak) or (Command = sResign) or
2746 (Command = sGetAIInfo) or (Command = sGetAICredits) or
2747 (Command = sGetVersion) or (Command and $FF0F = sGetChart)) then
2748 begin
2749 PutMessage(1 shl 16 + 1, Format('NOT Alive: %d', [Player]));
2750 result := eNoTurn;
2751 exit
2752 end;
2753
2754 result := eOK;
2755
2756 // check if command allowed now
2757 if (Mode = moPlaying) and not((Command >= cClientEx) or (Command = sMessage)
2758 or (Command = sSetDebugMap) or (Command = sGetDebugMap) or
2759 (Command = sGetAIInfo) or (Command = sGetAICredits) or
2760 (Command = sGetVersion) or (Command = sGetTechCost) or
2761 (Command = sGetDefender) or (Command = sGetUnitReport) or
2762 (Command = sGetCityReport) or (Command = sGetCityTileInfo) or
2763 (Command = sGetCity) or (Command = sGetEnemyCityReport) or
2764 (Command = sGetEnemyCityAreaInfo) or (Command = sGetCityReportNew) or
2765 (Command and $FF0F = sGetChart) or (Command and $FF0F = sSetAttitude))
2766 // commands always allowed
2767 and not((Player = pTurn) and (Command < $1000))
2768 // info request always allowed for pTurn
2769 and ((pDipActive < 0) and (Player <> pTurn) // not his turn
2770 or (pDipActive >= 0) and (Player <> pDipActive)
2771 // not active in negotiation mode
2772 or (pDipActive >= 0) and (Command and sctMask <> sctEndClient)) then
2773 // no nego command
2774 begin
2775 PutMessage(1 shl 16 + 1, Format('No Turn: %d calls %x',
2776 [Player, Command shr 4]));
2777 result := eNoTurn;
2778 exit
2779 end;
2780
2781 // do not use EXIT hereafter!
2782
2783{$IFOPT O-}
2784 HandoverStack[nHandoverStack] := Player + $1000;
2785 HandoverStack[nHandoverStack + 1] := Command;
2786 inc(nHandoverStack, 2);
2787
2788 InvalidTreatyMap := 0;
2789 // new command, sIntExpandTerritory of previous command was processed
2790{$ENDIF}
2791 if (Mode = moPlaying) and (Command >= sExecute) and
2792 ((Command and sctMask <> sctEndClient) or (Command = sTurn)) and
2793 (Command and sctMask <> sctModel) and (Command <> sCancelTreaty) and
2794 (Command <> sSetCityTiles) and (Command <> sBuyCityProject) and
2795 ((Command < cClientEx) or ProcessClientData[Player]) then
2796 begin { log command }
2797 FormerCLState := CL.State;
2798 CL.Put(Command, Player, Subject, @Data);
2799 logged := true;
2800 end
2801 else
2802 logged := false;
2803
2804 case Command of
2805
2806 {
2807 Info Request Commands
2808 ____________________________________________________________________
2809 }
2810 sMessage:
2811 bix[0].Client(cDebugMessage, Subject, Data);
2812
2813 sSetDebugMap:
2814 DebugMap[Player] := @Data;
2815
2816 sGetDebugMap:
2817 pointer(Data) := DebugMap[Subject];
2818
2819 { sChangeSuperView:
2820 if Difficulty[Player]=0 then
2821 begin
2822 for i:=0 to nBrain-1 do if Brain[i].Initialized then
2823 CallClient(i, cShowSuperView, Subject)
2824 end
2825 else result:=eInvalid; }
2826
2827 sRefreshDebugMap:
2828 bix[0].Client(cRefreshDebugMap, -1, Player);
2829
2830 sGetChart .. sGetChart + (nStat - 1) shl 4:
2831 if (Subject >= 0) and (Subject < nPl) and Assigned(bix[Subject]) then
2832 begin
2833 StopTurn := 0;
2834 if (Difficulty[Player] = 0) or (GTestFlags and tfUncover <> 0)
2835 // supervisor
2836 or (Subject = Player) // own chart
2837 or (GWinner > 0) // game end chart
2838 or (1 shl Subject and GAlive = 0) then // chart of extinct nation
2839 if Subject > Player then
2840 StopTurn := GTurn
2841 else
2842 StopTurn := GTurn + 1
2843 else if RW[Player].Treaty[Subject] > trNoContact then
2844 if Command shr 4 and $F = stMil then
2845 StopTurn := RW[Player].EnemyReport[Subject].TurnOfMilReport + 1
2846 else
2847 StopTurn := RW[Player].EnemyReport[Subject].TurnOfCivilReport + 1;
2848 move(Stat[Command shr 4 and $F, Subject]^, Data,
2849 StopTurn * SizeOf(integer));
2850 FillChar(TChart(Data)[StopTurn], (GTurn - StopTurn) *
2851 SizeOf(integer), 0);
2852 end
2853 else
2854 result := eInvalid;
2855
2856 sGetTechCost:
2857 integer(Data) := TechCost(Player);
2858
2859 sGetAIInfo:
2860 if AIInfo[Subject] = '' then
2861 pchar(Data) := nil
2862 else
2863 pchar(Data) := @AIInfo[Subject][1];
2864
2865 sGetAICredits:
2866 if AICredits = '' then
2867 pchar(Data) := nil
2868 else
2869 pchar(Data) := @AICredits[1];
2870
2871 sGetVersion:
2872 integer(Data) := Version;
2873
2874 sGetGameChanged:
2875 if Player <> 0 then
2876 result := eInvalid
2877 else if (CL <> nil) and (CL.State.nLog = nLogOpened) and
2878 (CL.State.MoveCode = 0) and not HasCityTileChanges and
2879 not HasChanges(Player) then
2880 result := eNotChanged;
2881
2882 sGetTileInfo:
2883 if (Subject >= 0) and (Subject < MapSize) then
2884 result := GetTileInfo(Player, -2, Subject, TTileInfo(Data))
2885 else
2886 result := eInvalid;
2887
2888 sGetCityTileInfo:
2889 if (Subject >= 0) and (Subject < MapSize) then
2890 result := GetTileInfo(Player, -1, Subject, TTileInfo(Data))
2891 else
2892 result := eInvalid;
2893
2894 sGetHypoCityTileInfo:
2895 if (Subject >= 0) and (Subject < MapSize) then
2896 begin
2897 if (TTileInfo(Data).ExplCity < 0) or
2898 (TTileInfo(Data).ExplCity >= RW[Player].nCity) then
2899 result := eInvalid
2900 else if ObserveLevel[Subject] shr (Player * 2) and 3 = 0 then
2901 result := eNoPreq
2902 else
2903 result := GetTileInfo(Player, TTileInfo(Data).ExplCity, Subject,
2904 TTileInfo(Data))
2905 end
2906 else
2907 result := eInvalid;
2908
2909 sGetJobProgress:
2910 if (Subject >= 0) and (Subject < MapSize) then
2911 begin
2912 if ObserveLevel[Subject] shr (Player * 2) and 3 = 0 then
2913 result := eNoPreq
2914 else
2915 result := GetJobProgress(Player, Subject, TJobProgressData(Data))
2916 end
2917 else
2918 result := eInvalid;
2919
2920 sGetModels:
2921 if (GTestFlags and tfUncover <> 0) or (Difficulty[Player] = 0)
2922 then { supervisor only command }
2923 begin
2924 for p1 := 0 to nPl - 1 do
2925 if (p1 <> Player) and (1 shl p1 and GAlive <> 0) then
2926 for mix := 0 to RW[p1].nModel - 1 do
2927 TellAboutModel(Player, p1, mix);
2928 end
2929 else
2930 result := eInvalid;
2931
2932 sGetUnits:
2933 if (Subject >= 0) and (Subject < MapSize) and
2934 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) then
2935 integer(Data) := GetUnitStack(Player, Subject)
2936 else
2937 result := eNoPreq;
2938
2939 sGetDefender:
2940 if (Subject >= 0) and (Subject < MapSize) and (Occupant[Subject] = Player)
2941 then
2942 Strongest(Subject, integer(Data), d, i, j)
2943 else
2944 result := eInvalid;
2945
2946 sGetBattleForecast, sGetBattleForecastEx:
2947 if (Subject >= 0) and (Subject < MapSize) and
2948 (ObserveLevel[Subject] and (3 shl (Player * 2)) > 0) then
2949 with TBattleForecast(Data) do
2950 if (1 shl pAtt and GAlive <> 0) and (mixAtt >= 0) and
2951 (mixAtt < RW[pAtt].nModel) and
2952 ((pAtt = Player) or (RWemix[Player, pAtt, mixAtt] >= 0)) then
2953 begin
2954 result := GetBattleForecast(Subject, TBattleForecast(Data), uix1,
2955 cix1, AStr, DStr, ABaseDamage, DBaseDamage);
2956 if Command = sGetBattleForecastEx then
2957 begin
2958 TBattleForecastEx(Data).AStr := (AStr + 200) div 400;
2959 TBattleForecastEx(Data).DStr := (DStr + 200) div 400;
2960 TBattleForecastEx(Data).ABaseDamage := ABaseDamage;
2961 TBattleForecastEx(Data).DBaseDamage := DBaseDamage;
2962 end;
2963 if result = eOK then
2964 result := eInvalid // no enemy unit there!
2965 end
2966 else
2967 result := eInvalid
2968 else
2969 result := eInvalid;
2970
2971 sGetUnitReport:
2972 if (Subject < 0) or (Subject >= RW[Player].nUn) or
2973 (RW[Player].Un[Subject].Loc < 0) then
2974 result := eInvalid
2975 else
2976 GetUnitReport(Player, Subject, TUnitReport(Data));
2977
2978 sGetMoveAdvice:
2979 if (Subject < 0) or (Subject >= RW[Player].nUn) or
2980 (RW[Player].Un[Subject].Loc < 0) then
2981 result := eInvalid
2982 else
2983 result := GetMoveAdvice(Player, Subject, TMoveAdviceData(Data));
2984
2985 sGetPlaneReturn:
2986 if (Subject < 0) or (Subject >= RW[Player].nUn) or
2987 (RW[Player].Un[Subject].Loc < 0) or
2988 (RW[Player].Model[RW[Player].Un[Subject].mix].Domain <> dAir) then
2989 result := eInvalid
2990 else
2991 begin
2992 if CanPlaneReturn(Player, Subject, TPlaneReturnData(Data)) then
2993 result := eOK
2994 else
2995 result := eNoWay
2996 end;
2997
2998 sGetCity:
2999 if (Subject >= 0) and (Subject < MapSize) and
3000 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and
3001 (RealMap[Subject] and fCity <> 0) then
3002 with TGetCityData(Data) do
3003 begin
3004 Owner := Player;
3005 SearchCity(Subject, Owner, cix1);
3006 c := RW[Owner].City[cix1];
3007 if (Owner <> Player) and (c.Project and cpImp = 0) then
3008 TellAboutModel(Player, Owner, c.Project and cpIndex);
3009 end
3010 else
3011 result := eInvalid;
3012
3013 sGetCityReport:
3014 if (Subject < 0) or (Subject >= RW[Player].nCity) or
3015 (RW[Player].City[Subject].Loc < 0) then
3016 result := eInvalid
3017 else
3018 result := GetCityReport(Player, Subject, TCityReport(Data));
3019
3020 sGetCityReportNew:
3021 if (Subject < 0) or (Subject >= RW[Player].nCity) or
3022 (RW[Player].City[Subject].Loc < 0) then
3023 result := eInvalid
3024 else
3025 GetCityReportNew(Player, Subject, TCityReportNew(Data));
3026
3027 sGetCityAreaInfo:
3028 if (Subject < 0) or (Subject >= RW[Player].nCity) or
3029 (RW[Player].City[Subject].Loc < 0) then
3030 result := eInvalid
3031 else
3032 GetCityAreaInfo(Player, RW[Player].City[Subject].Loc,
3033 TCityAreaInfo(Data));
3034
3035 sGetEnemyCityReport:
3036 if (Subject >= 0) and (Subject < MapSize) and
3037 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and
3038 (RealMap[Subject] and fCity <> 0) then
3039 begin
3040 p1 := Occupant[Subject];
3041 if p1 < 0 then
3042 p1 := 1;
3043 SearchCity(Subject, p1, cix1);
3044 TCityReport(Data).HypoTiles := -1;
3045 TCityReport(Data).HypoTax := -1;
3046 TCityReport(Data).HypoLux := -1;
3047 GetCityReport(p1, cix1, TCityReport(Data))
3048 end
3049 else
3050 result := eInvalid;
3051
3052 sGetEnemyCityReportNew:
3053 if (Subject >= 0) and (Subject < MapSize) and
3054 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and
3055 (RealMap[Subject] and fCity <> 0) then
3056 begin
3057 p1 := Occupant[Subject];
3058 if p1 < 0 then
3059 p1 := 1;
3060 SearchCity(Subject, p1, cix1);
3061 TCityReport(Data).HypoTiles := -1;
3062 TCityReport(Data).HypoTax := -1;
3063 TCityReport(Data).HypoLux := -1;
3064 GetCityReportNew(p1, cix1, TCityReportNew(Data));
3065 end
3066 else
3067 result := eInvalid;
3068
3069 sGetEnemyCityAreaInfo:
3070 if (Subject >= 0) and (Subject < MapSize) and
3071 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and
3072 (RealMap[Subject] and fCity <> 0) then
3073 begin
3074 p1 := Occupant[Subject];
3075 if p1 < 0 then
3076 p1 := 1;
3077 SearchCity(Subject, p1, cix1);
3078 GetCityAreaInfo(p1, Subject, TCityAreaInfo(Data))
3079 end
3080 else
3081 result := eInvalid;
3082
3083 sGetCityTileAdvice:
3084 if (Subject < 0) or (Subject >= RW[Player].nCity) or
3085 (RW[Player].City[Subject].Loc < 0) then
3086 result := eInvalid
3087 else
3088 GetCityTileAdvice(Player, Subject, TCityTileAdviceData(Data));
3089
3090 {
3091 Map Editor Commands
3092 ____________________________________________________________________
3093 }
3094 sEditTile:
3095 if Player = 0 then
3096 with TEditTileData(Data) do
3097 EditTile(Loc, NewTile)
3098 else
3099 result := eInvalid;
3100
3101 sRandomMap:
3102 if (Player = 0) and MapGeneratorAvailable then
3103 begin
3104 CreateElevation;
3105 PreviewElevation := false;
3106 CreateMap(false);
3107 FillChar(ObserveLevel, MapSize * 4, 0);
3108 DiscoverAll(Player, lObserveSuper);
3109 end
3110 else
3111 result := eInvalid;
3112
3113 sMapGeneratorRequest:
3114 if not MapGeneratorAvailable then
3115 result := eInvalid;
3116
3117 {
3118 Client Deactivation Commands
3119 ____________________________________________________________________
3120 }
3121 sTurn, sTurn - sExecute:
3122 begin
3123 AllHumansDead := true;
3124 for p1 := 0 to nPl - 1 do
3125 if (1 shl p1 and GAlive <> 0) and (bix[p1].Kind = btTerm) then
3126 AllHumansDead := false;
3127 if (pDipActive >= 0) // still in negotiation mode
3128 or (pTurn = 0) and ((GWinner > 0) or (GTurn = MaxTurn) or
3129 (Difficulty[0] > 0) and AllHumansDead) then // game end reached
3130 result := eViolation
3131 else if Command >= sExecute then
3132 begin
3133 if Mode = moPlaying then
3134 begin
3135 CL.State := FormerCLState;
3136 LogCityTileChanges;
3137{$IFNDEF SCR}
3138 if pTurn = 0 then
3139 begin
3140 LogChanges;
3141 SaveGame('~' + LogFileName, true);
3142 end
3143{$ENDIF}
3144 end
3145 else if (Mode = moMovie) and (pTurn = 0) then
3146 CallPlayer(cMovieEndTurn, 0, nil^);
3147 GWatching := GWatching and GAlive or 1;
3148 RW[pTurn].Happened := 0;
3149 uixSelectedTransport := -1;
3150 SpyMission := smSabotageProd;
3151 if 1 shl pTurn and GAlive <> 0 then
3152 begin
3153 // calculate checksum
3154 TotalFood := 0;
3155 TotalProd := 0;
3156 for i := 0 to RW[pTurn].nCity - 1 do
3157 if RW[pTurn].City[i].Loc >= 0 then
3158 begin
3159 inc(TotalFood, RW[pTurn].City[i].Food);
3160 inc(TotalProd, RW[pTurn].City[i].Prod);
3161 end;
3162 CheckSum := TotalFood and 7 + TotalProd and 7 shl 3 +
3163 RW[pTurn].Money and 7 shl 6 + Worked[pTurn] div 100 and 7 shl 9;
3164 end
3165 else
3166 CheckSum := 0;
3167
3168 if Mode < moPlaying then // check checksum
3169 begin
3170 if CheckSum <> Subject then
3171 LoadOK := false
3172 end
3173 else // save checksum
3174 CL.Put(Command, Player, CheckSum, @Data);
3175{$IFDEF TEXTLOG}
3176 CmdInfo := '';
3177 if CheckSum and 7 <> Subject and 7 then
3178 CmdInfo := Format('***ERROR (Food %d) ',
3179 [(CheckSum and 7 - Subject and 7 + 12) mod 8 - 4]) + CmdInfo;
3180 if CheckSum shr 3 and 7 <> Subject shr 3 and 7 then
3181 CmdInfo := '***ERROR (Prod) ' + CmdInfo;
3182 if CheckSum shr 6 and 7 <> Subject shr 6 and 7 then
3183 CmdInfo := '***ERROR (Research) ' + CmdInfo;
3184 if CheckSum shr 9 and 7 <> Subject shr 9 and 7 then
3185 CmdInfo := '***ERROR (Work) ' + CmdInfo;
3186{$ENDIF}
3187 if 1 shl pTurn and GAlive <> 0 then
3188 begin
3189 AfterTurn;
3190 if Mode < moPlaying then
3191 InsertTerritoryUpdateCommands;
3192 // if bix[pTurn]=bixTerm then UpdateBorderHelper;
3193 end;
3194
3195 repeat
3196 pTurn := (pTurn + 1) mod nPl;
3197 if pTurn = 0 then
3198 inc(GTurn);
3199 if Assigned(bix[pTurn]) and ((1 shl pTurn) and GAlive = 0) then
3200 begin // already made extinct -- continue statistics
3201 Stat[stExplore, pTurn, GTurn] := 0;
3202 Stat[stPop, pTurn, GTurn] := 0;
3203 Stat[stTerritory, pTurn, GTurn] := 0;
3204 Stat[stScience, pTurn, GTurn] := 0;
3205 Stat[stWork, pTurn, GTurn] := 0;
3206 Stat[stMil, pTurn, GTurn] := 0;
3207 end;
3208 until (pTurn = 0) or ((1 shl pTurn and (GAlive or GWatching) <> 0) and
3209 (GWinner = 0));
3210 if (Mode = moLoading_Fast) and
3211 ((GTurn = LoadTurn) or (GTurn = LoadTurn - 1) and (pTurn > 0)) then
3212 Mode := moLoading;
3213 if Mode = moPlaying then
3214 begin
3215 CCCommand := cTurn;
3216 CCPlayer := pTurn;
3217 Notify(ntNextPlayer)
3218 end
3219 else
3220 begin
3221 if GTurn = 0 then
3222 BeforeTurn0
3223 else
3224 BeforeTurn;
3225 if (Mode = moMovie) and (pTurn = 0) then
3226 begin
3227 Inform(pTurn);
3228 CallPlayer(cMovieTurn, 0, nil^);
3229 end;
3230 end;
3231{$IFDEF TEXTLOG}CmdInfo := CmdInfo + Format('---Turn %d P%d---', [GTurn, pTurn]); {$ENDIF}
3232 end;
3233 end; // sTurn
3234
3235 sBreak, sResign, sNextRound, sReload:
3236 if Mode = moMovie then
3237 MovieStopped := true
3238 else
3239 begin
3240 if Command = sReload then
3241 begin
3242 ok := (Difficulty[0] = 0) and (bix[0].Kind <> btNoTerm) and
3243 (integer(Data) >= 0) and (integer(Data) < GTurn);
3244 for p1 := 1 to nPl - 1 do
3245 if bix[p1].Kind = btTerm then
3246 ok := false;
3247 // allow reload in AI-only games only
3248 end
3249 else
3250 ok := Player = 0;
3251 if ok then
3252 begin
3253 if (Command = sBreak) or (Command = sResign) then
3254 Notify(ntBackOn);
3255 for i := 0 to Brains.Count - 1 do
3256 if Brains[i].Initialized then
3257 begin
3258 if Brains[i].Kind = btAI then
3259 Notify(ntDeinitModule + i);
3260 CallClient(i, cBreakGame, nil^);
3261 end;
3262 Notify(ntEndInfo);
3263 if (Command = sBreak) or (Command = sReload) then
3264 begin
3265 LogCityTileChanges;
3266 LogChanges;
3267 SaveGame(LogFileName, false);
3268 end;
3269 DeleteFile(SavePath + '~' + LogFileName);
3270 EndGame;
3271 case Command of
3272 sBreak:
3273 Notify(ntStartGoRefresh);
3274 sResign:
3275 Notify(ntStartGo);
3276 sNextRound:
3277 StartNewGame(SavePath, LogFileName, MapFileName, lx, ly,
3278 LandMass, MaxTurn);
3279 sReload:
3280 LoadGame(SavePath, LogFileName, integer(Data), false);
3281 end
3282 end
3283 else
3284 result := eInvalid;
3285 end;
3286
3287 sAbandonMap, sSaveMap:
3288 if Player = 0 then
3289 begin
3290 if Command = sSaveMap then
3291 SaveMap(MapFileName);
3292 Notify(ntBackOn);
3293 BrainTerm.Client(cBreakGame, -1, nil^);
3294 ReleaseMapEditor;
3295 if Command = sSaveMap then
3296 Notify(ntStartGoRefreshMaps)
3297 else
3298 Notify(ntStartGo)
3299 end
3300 else
3301 result := eInvalid;
3302
3303 scContact .. scContact + (nPl - 1) shl 4, scContact - sExecute .. scContact
3304 - sExecute + (nPl - 1) shl 4:
3305 if (pDipActive >= 0) or (1 shl (Command shr 4 and $F) and GAlive = 0) then
3306 result := eInvalid
3307 else if GWinner > 0 then
3308 result := eViolation // game end reached
3309 else if RW[Player].Treaty[Command shr 4 and $F] = trNoContact then
3310 result := eNoPreq
3311 else if GTurn < GColdWarStart + ColdWarTurns then
3312 result := eColdWar
3313 else if RW[Player].Government = gAnarchy then
3314 result := eAnarchy
3315 else if RW[Command shr 4 and $F].Government = gAnarchy then
3316 begin
3317 result := eAnarchy;
3318 LastEndClientCommand := scReject; // enable cancel treaty
3319 pContacted := Command shr 4 and $F;
3320 end
3321 else if Command >= sExecute then
3322 begin // contact request
3323 pContacted := Command shr 4 and $F;
3324 pDipActive := pContacted;
3325 assert(Mode = moPlaying);
3326 Inform(pDipActive);
3327 ChangeClientWhenDone(scContact, pDipActive, pTurn, 4);
3328 end;
3329
3330 scReject, scReject - sExecute:
3331 if LastEndClientCommand and $FF0F = scContact then
3332 begin
3333 if Command >= sExecute then
3334 begin // contact requested and not accepted yet
3335 pDipActive := -1;
3336 assert(Mode = moPlaying);
3337 ChangeClientWhenDone(cContinue, pTurn, nil^, 0);
3338 end
3339 end
3340 else
3341 result := eInvalid;
3342
3343 scDipStart, scDipStart - sExecute:
3344 if LastEndClientCommand and $FF0F = scContact then
3345 begin
3346 if Command >= sExecute then
3347 begin // accept contact
3348 pContacted := pDipActive;
3349 RW[pContacted].EnemyReport[pTurn].Credibility :=
3350 RW[pTurn].Credibility;
3351 pDipActive := pTurn;
3352 assert(Mode = moPlaying);
3353 IntServer(sIntHaveContact, pTurn, pContacted, nil^);
3354 ChangeClientWhenDone(scDipStart, pDipActive, nil^, 0);
3355 end
3356 end
3357 else
3358 result := eInvalid;
3359
3360 scDipNotice, scDipAccept, scDipCancelTreaty, scDipBreak,
3361 scDipNotice - sExecute, scDipAccept - sExecute,
3362 scDipCancelTreaty - sExecute, scDipBreak - sExecute:
3363 if pDipActive >= 0 then
3364 begin
3365 assert(Mode = moPlaying);
3366 if pDipActive = pTurn then
3367 p1 := pContacted
3368 else
3369 p1 := pTurn;
3370 if (Command and not sExecute = scDipBreak and not sExecute) and
3371 (LastEndClientCommand <> scDipBreak) then // ok
3372 else if (Command and not sExecute = scDipNotice and not sExecute) and
3373 ((LastEndClientCommand = scDipCancelTreaty) or
3374 (LastEndClientCommand = scDipBreak)) then // ok
3375 else if (Command and not sExecute = scDipAccept and not sExecute) and
3376 (LastEndClientCommand = scDipOffer) then
3377 with LastOffer do
3378 begin
3379 // check if offer can be accepted
3380 if nDeliver + nCost = 0 then
3381 result := eOfferNotAcceptable;
3382 for i := 0 to nDeliver + nCost - 1 do
3383 if Price[i] = opChoose then
3384 result := eOfferNotAcceptable;
3385 for i := 0 to nCost - 1 do
3386 if not PayPrice(pDipActive, p1, Price[nDeliver + i], false) then
3387 result := eOfferNotAcceptable;
3388 if (Command >= sExecute) and (result >= rExecuted) then
3389 begin
3390 IntServer(sIntPayPrices + nDeliver + nCost, p1, pDipActive,
3391 LastOffer);
3392 // CheckContact;
3393
3394 // tell other players about ship part trades
3395 HasShipChanged := false;
3396 FillChar(ShowShipChange, SizeOf(ShowShipChange), 0);
3397 for i := 0 to nDeliver + nCost - 1 do
3398 if Price[i] and opMask = opShipParts then
3399 begin
3400 HasShipChanged := true;
3401 if i >= nDeliver then
3402 begin // p1 has demanded from pDipActive
3403 ShowShipChange.Ship1Change[Price[i] shr 16 and 3] :=
3404 +integer(Price[i] and $FFFF);
3405 ShowShipChange.Ship2Change[Price[i] shr 16 and 3] :=
3406 -integer(Price[i] and $FFFF);
3407 end
3408 else
3409 begin // p1 has delivered to pDipActive
3410 ShowShipChange.Ship1Change[Price[i] shr 16 and 3] :=
3411 -integer(Price[i] and $FFFF);
3412 ShowShipChange.Ship2Change[Price[i] shr 16 and 3] :=
3413 +integer(Price[i] and $FFFF);
3414 end
3415 end;
3416 if HasShipChanged then
3417 begin
3418 ShowShipChange.Reason := scrTrade;
3419 ShowShipChange.Ship1Owner := p1;
3420 ShowShipChange.Ship2Owner := pDipActive;
3421 for p2 := 0 to nPl - 1 do
3422 if (p2 <> p1) and (p2 <> pDipActive) and
3423 (1 shl p2 and (GAlive or GWatching) <> 0) then
3424 begin
3425 move(GShip, RW[p2].Ship, SizeOf(GShip));
3426 if 1 shl p2 and GWatching <> 0 then
3427 CallPlayer(cShowShipChange, p2, ShowShipChange);
3428 end
3429 end
3430 end;
3431 end
3432 else if (Command and not sExecute = scDipCancelTreaty and not sExecute)
3433 and (RW[pDipActive].Treaty[p1] >= trPeace) then
3434 begin
3435 if (ServerVersion[pDipActive] >= $010100) and
3436 (GTurn < RW[pDipActive].LastCancelTreaty[p1] + CancelTreatyTurns)
3437 then
3438 result := eCancelTreatyRush
3439 else if Command >= sExecute then
3440 begin
3441 IntServer(sIntCancelTreaty, pDipActive, p1, nil^);
3442 for p2 := 0 to nPl - 1 do
3443 if (p2 <> p1) and (1 shl p2 and PeaceEnded <> 0) then
3444 begin
3445 i := p1 shl 4 + pDipActive;
3446 CallPlayer(cShowSupportAllianceAgainst, p2, i);
3447 end;
3448 for p2 := 0 to nPl - 1 do
3449 if (p2 <> p1) and (1 shl p2 and PeaceEnded <> 0) then
3450 begin
3451 i := p2;
3452 CallPlayer(cShowCancelTreatyByAlliance, pDipActive, i);
3453 end;
3454 end
3455 end
3456 else
3457 result := eInvalid;
3458 if (Command >= sExecute) and (result >= rExecuted) then
3459 if LastEndClientCommand = scDipBreak then
3460 begin // break negotiation
3461 pDipActive := -1;
3462 CallPlayer(cShowEndContact, pContacted, nil^);
3463 ChangeClientWhenDone(cContinue, pTurn, nil^, 0);
3464 end
3465 else
3466 begin
3467 if (GTestFlags and tfUncover <> 0) or (Difficulty[0] = 0) then
3468 with ShowNegoData do
3469 begin // display negotiation in log window
3470 pSender := pDipActive;
3471 pTarget := p1;
3472 Action := Command;
3473 bix[0].Client(cShowNego, 1 shl 16 + 3, ShowNegoData);
3474 end;
3475 pDipActive := p1;
3476 ChangeClientWhenDone(Command, pDipActive, nil^, 0);
3477 end
3478 end
3479 else
3480 result := eInvalid;
3481
3482 scDipOffer, scDipOffer - sExecute:
3483 if (pDipActive >= 0) and (LastEndClientCommand <> scDipCancelTreaty) and
3484 (LastEndClientCommand <> scDipBreak) then
3485 if (LastEndClientCommand = scDipOffer) and
3486 (LastOffer.nDeliver + LastOffer.nCost + TOffer(Data).nDeliver +
3487 TOffer(Data).nCost = 0) then
3488 begin
3489 if Command >= sExecute then
3490 begin // agreed discussion end
3491 pDipActive := -1;
3492 CallPlayer(cShowEndContact, pContacted, nil^);
3493 assert(Mode = moPlaying);
3494 ChangeClientWhenDone(cContinue, pTurn, nil^, 0);
3495 end
3496 end
3497 else
3498 begin
3499 // check if offer can be made
3500 if pDipActive = pTurn then
3501 p1 := pContacted
3502 else
3503 p1 := pTurn;
3504 if RW[pDipActive].Treaty[p1] < trPeace then
3505 begin // no tribute allowed!
3506 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do
3507 if (TOffer(Data).Price[i] and opMask = opTribute) then
3508 result := eInvalidOffer;
3509 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do
3510 if (TOffer(Data).Price[i] = opTreaty + trPeace) then
3511 result := eOK;
3512 end;
3513 for i := 0 to TOffer(Data).nDeliver - 1 do
3514 if (TOffer(Data).Price[i] <> opChoose) and
3515 not PayPrice(pDipActive, p1, TOffer(Data).Price[i], false) then
3516 result := eInvalidOffer;
3517 if CountPrice(TOffer(Data), opTreaty) > 1 then
3518 result := eInvalidOffer;
3519 for i := 0 to nShipPart - 1 do
3520 if CountPrice(TOffer(Data), opShipParts + i shl 16) > 1 then
3521 result := eInvalidOffer;
3522 if CountPrice(TOffer(Data), opMoney) > 1 then
3523 result := eInvalidOffer;
3524 if CountPrice(TOffer(Data), opTribute) > 1 then
3525 result := eInvalidOffer;
3526 case CountPrice(TOffer(Data), opChoose) of
3527 0:
3528 ;
3529 1:
3530 if (TOffer(Data).nCost = 0) or (TOffer(Data).nDeliver = 0) then
3531 result := eInvalidOffer;
3532 else
3533 result := eInvalidOffer;
3534 end;
3535
3536 // !!! check here if cost can be demanded
3537
3538 if (Command >= sExecute) and (result >= rExecuted) then
3539 begin
3540 OfferFullySupported := (TOffer(Data).nDeliver <= 2) and
3541 (TOffer(Data).nCost <= 2); // >2 no more allowed
3542 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do
3543 begin
3544 if TOffer(Data).Price[i] and opMask = opTribute then
3545 OfferFullySupported := false;
3546 // tribute no more part of the game
3547 if (TOffer(Data).Price[i] and opMask = opTreaty) and
3548 (TOffer(Data).Price[i] - opTreaty <= RW[pDipActive].Treaty[p1])
3549 then
3550 OfferFullySupported := false;
3551 // agreed treaty end no more part of the game
3552 if TOffer(Data).Price[i] = opTreaty + trCeaseFire then
3553 OfferFullySupported := false;
3554 // ceasefire no more part of the game
3555 end;
3556 if not OfferFullySupported then
3557 begin
3558 // some elements have been removed from the game -
3559 // automatically respond will null-offer
3560 LastOffer.nDeliver := 0;
3561 LastOffer.nCost := 0;
3562 ChangeClientWhenDone(scDipOffer, pDipActive, LastOffer,
3563 SizeOf(LastOffer));
3564 end
3565 else
3566 begin
3567 if (GTestFlags and tfUncover <> 0) or (Difficulty[0] = 0) then
3568 with ShowNegoData do
3569 begin // display negotiation in log window
3570 pSender := pDipActive;
3571 pTarget := p1;
3572 Action := Command;
3573 Offer := TOffer(Data);
3574 bix[0].Client(cShowNego, 1 shl 16 + 3, ShowNegoData);
3575 end;
3576 LastOffer := TOffer(Data);
3577 // show offered things to receiver
3578 for i := 0 to LastOffer.nDeliver - 1 do
3579 ShowPrice(pDipActive, p1, LastOffer.Price[i]);
3580 pDipActive := p1;
3581 assert(Mode = moPlaying);
3582 ChangeClientWhenDone(scDipOffer, pDipActive, LastOffer,
3583 SizeOf(LastOffer));
3584 end
3585 end
3586 end
3587 else
3588 result := eInvalid;
3589
3590 {
3591 General Commands
3592 ____________________________________________________________________
3593 }
3594 sClearTestFlag:
3595 if Player = 0 then
3596 begin
3597{$IFDEF TEXTLOG}CmdInfo := Format('ClearTestFlag %x', [Subject]); {$ENDIF}
3598 ClearTestFlags(Subject);
3599 end
3600 else
3601 result := eInvalid;
3602
3603 sSetTestFlag:
3604 if Player = 0 then
3605 begin
3606{$IFDEF TEXTLOG}CmdInfo := Format('SetTestFlag %x', [Subject]); {$ENDIF}
3607 SetTestFlags(Player, Subject);
3608 // CheckContact;
3609 end
3610 else
3611 result := eInvalid;
3612
3613 sSetGovernment, sSetGovernment - sExecute:
3614 begin
3615{$IFDEF TEXTLOG}CmdInfo := Format('SetGovernment P%d: %d', [Player, Subject]); {$ENDIF}
3616 if RW[Player].Happened and phChangeGov = 0 then
3617 result := eViolation
3618 else if RW[Player].Government = Subject then
3619 result := eNotChanged
3620 else if (Subject >= nGov) then
3621 result := eInvalid
3622 else if (Subject >= gMonarchy) and
3623 (RW[Player].Tech[GovPreq[Subject]] < tsApplicable) then
3624 result := eNoPreq
3625 else if Command >= sExecute then
3626 begin
3627 RW[Player].Government := Subject;
3628 for p1 := 0 to nPl - 1 do
3629 if (p1 <> Player) and ((GAlive or GWatching) and (1 shl p1) <> 0)
3630 then
3631 RW[p1].EnemyReport[Player].Government := Subject;
3632 end
3633 end;
3634
3635 sSetRates, sSetRates - sExecute:
3636 begin
3637{$IFDEF TEXTLOG}CmdInfo := Format('SetRates P%d: %d/%d', [Player, Subject and $F * 10, Subject shr 4 * 10]); {$ENDIF}
3638 if Subject and $F + Subject shr 4 > 10 then
3639 result := eInvalid
3640 else if (RW[Player].TaxRate = Subject and $F * 10) and
3641 (RW[Player].LuxRate = Subject shr 4 * 10) then
3642 result := eNotChanged
3643 else if Command >= sExecute then
3644 begin
3645 RW[Player].TaxRate := Subject and $F * 10;
3646 RW[Player].LuxRate := Subject shr 4 * 10;
3647 end
3648 end;
3649
3650 sRevolution:
3651 begin
3652{$IFDEF TEXTLOG}CmdInfo := Format('Revolution P%d', [Player]); {$ENDIF}
3653 if RW[Player].Government = gAnarchy then
3654 result := eInvalid
3655 else
3656 begin
3657 RW[Player].Government := gAnarchy;
3658 for p1 := 0 to nPl - 1 do
3659 if (p1 <> Player) and ((GAlive or GWatching) and (1 shl p1) <> 0)
3660 then
3661 RW[p1].EnemyReport[Player].Government := gAnarchy;
3662 RW[Player].AnarchyStart := GTurn;
3663 end;
3664 end;
3665
3666 sSetResearch, sSetResearch - sExecute:
3667 with RW[Player] do
3668 begin
3669{$IFDEF TEXTLOG}CmdInfo := Format('SetResearch P%d: %d', [Player, Subject]);
3670 {$ENDIF}
3671 if (Happened and phTech <> 0) and
3672 ((Subject < nAdv) or (Subject = adMilitary)) then
3673 begin
3674 if (Mode = moPlaying) and (Subject = adMilitary) and
3675 (DevModelTurn[Player] <> GTurn) then
3676 result := eNoModel
3677 else if Subject <> adMilitary then
3678 begin
3679 if Subject = futComputingTechnology then
3680 begin
3681 if Tech[Subject] >= MaxFutureTech_Computing then
3682 result := eInvalid
3683 end
3684 else if Subject in FutureTech then
3685 begin
3686 if Tech[Subject] >= MaxFutureTech then
3687 result := eInvalid
3688 end
3689 else if Tech[Subject] >= tsApplicable then
3690 result := eInvalid; // already discovered
3691 if Tech[Subject] <> tsSeen then // look if preqs met
3692 if AdvPreq[Subject, 2] <> preNone then
3693 begin // 2 of 3 required
3694 i := 0;
3695 for j := 0 to 2 do
3696 if Tech[AdvPreq[Subject, j]] >= tsApplicable then
3697 inc(i);
3698 if i < 2 then
3699 result := eNoPreq
3700 end
3701 else if (AdvPreq[Subject, 0] <> preNone) and
3702 (Tech[AdvPreq[Subject, 0]] < tsApplicable) or
3703 (AdvPreq[Subject, 1] <> preNone) and
3704 (Tech[AdvPreq[Subject, 1]] < tsApplicable) then
3705 result := eNoPreq
3706 end;
3707 if (result = eOK) and (Command >= sExecute) then
3708 begin
3709 if (Mode = moPlaying) and (Subject = adMilitary) then
3710 IntServer(sIntSetDevModel, Player, 0, DevModel.Kind);
3711 // save DevModel, because sctModel commands are not logged
3712 ResearchTech := Subject;
3713 end
3714 end
3715 else
3716 result := eViolation;
3717 end;
3718
3719 sStealTech, sStealTech - sExecute:
3720 begin
3721{$IFDEF TEXTLOG}CmdInfo := Format('StealTech P%d: %d', [Player, Subject]);
3722 {$ENDIF}
3723 if RW[Player].Happened and phStealTech = 0 then
3724 result := eInvalid
3725 else if (Subject >= nAdv) or (Subject in FutureTech) or
3726 (RW[Player].Tech[Subject] >= tsSeen) or
3727 (RW[GStealFrom].Tech[Subject] < tsApplicable) then
3728 result := eInvalid
3729 else if Command >= sExecute then
3730 begin
3731 SeeTech(Player, Subject);
3732 dec(RW[Player].Happened, phStealTech);
3733 end
3734 end;
3735
3736 sSetAttitude .. sSetAttitude + (nPl - 1) shl 4,
3737 sSetAttitude - sExecute .. sSetAttitude - sExecute + (nPl - 1) shl 4:
3738 begin
3739 p1 := Command shr 4 and $F;
3740{$IFDEF TEXTLOG}CmdInfo := Format('SetAttitude P%d to P%d: %d', [Player, p1, Subject]); {$ENDIF}
3741 if (Subject >= nAttitude) or (p1 >= nPl) or
3742 (RW[Player].EnemyReport[p1] = nil) then
3743 result := eInvalid
3744 else if RW[Player].Treaty[p1] = trNoContact then
3745 result := eNoPreq
3746 else if RW[Player].Attitude[p1] = Subject then
3747 result := eNotChanged
3748 else if Command >= sExecute then
3749 begin
3750 RW[Player].Attitude[p1] := Subject;
3751 RW[p1].EnemyReport[Player].Attitude := Subject;
3752 end
3753 end;
3754
3755 sCancelTreaty, sCancelTreaty - sExecute:
3756 if (LastEndClientCommand <> scReject) or
3757 (RW[Player].Treaty[pContacted] < trPeace) then
3758 result := eInvalid
3759 else if (ServerVersion[Player] >= $010100) and
3760 (GTurn < RW[Player].LastCancelTreaty[pContacted] + CancelTreatyTurns)
3761 then
3762 result := eCancelTreatyRush
3763 else if Command >= sExecute then
3764 begin
3765 CallPlayer(cShowCancelTreaty, pContacted, Player);
3766 IntServer(sIntCancelTreaty, Player, pContacted, nil^);
3767 for p2 := 0 to nPl - 1 do
3768 if (p2 <> pContacted) and (1 shl p2 and PeaceEnded <> 0) then
3769 begin
3770 i := pContacted shl 4 + Player;
3771 CallPlayer(cShowSupportAllianceAgainst, p2, i);
3772 end;
3773 for p2 := 0 to nPl - 1 do
3774 if (p2 <> pContacted) and (1 shl p2 and PeaceEnded <> 0) then
3775 begin
3776 i := p2;
3777 CallPlayer(cShowCancelTreatyByAlliance, Player, i);
3778 end;
3779 LastEndClientCommand := sTurn;
3780 end;
3781
3782 {
3783 Model Related Commands
3784 ____________________________________________________________________
3785 }
3786 sCreateDevModel, sCreateDevModel - sExecute:
3787 begin
3788{$IFDEF TEXTLOG}CmdInfo := Format('CreateDevModel P%d', [Player]); {$ENDIF}
3789 if Subject >= 4 then
3790 result := eInvalid
3791 else if (upgrade[Subject, 0].Preq <> preNone) and
3792 (RW[Player].Tech[upgrade[Subject, 0].Preq] < tsApplicable) then
3793 result := eNoPreq
3794 else if Command >= sExecute then
3795 begin
3796 with RW[Player].DevModel do
3797 begin
3798 Domain := Subject;
3799 MStrength := 0;
3800 MTrans := 0;
3801 MCost := 0;
3802 Upgrades := 0;
3803 FutureMCost := 0;
3804 for i := 0 to nUpgrade - 1 do
3805 with upgrade[Domain, i] do
3806 if (Preq = preNone) or (Preq >= 0) and
3807 ((RW[Player].Tech[Preq] >= tsApplicable) or
3808 (Preq in FutureTech) and (RW[Player].Tech[Preq] >= 0)) then
3809 begin
3810 if Preq in FutureTech then
3811 begin
3812 j := RW[Player].Tech[Preq];
3813 inc(FutureMCost, j * Cost);
3814 end
3815 else
3816 begin
3817 j := 1;
3818 if Cost > MCost then
3819 MCost := Cost;
3820 end;
3821 inc(Upgrades, 1 shl i);
3822 inc(MStrength, j * Strength);
3823 inc(MTrans, j * Trans);
3824 end;
3825 inc(MCost, FutureMCost);
3826 FillChar(Cap, SizeOf(Cap), 0);
3827 Cap[mcOffense] := 2;
3828 Cap[mcDefense] := 1;
3829 for i := 0 to nFeature - 1 do
3830 with Feature[i] do
3831 if (1 shl Domain and Domains <> 0) and
3832 ((Preq = preNone) or (Preq = preSun) and
3833 (GWonder[woSun].EffectiveOwner = Player) or (Preq >= 0) and
3834 (RW[Player].Tech[Preq] >= tsApplicable)) and (i in AutoFeature)
3835 then
3836 Cap[i] := 1;
3837 MaxWeight := 5;
3838 if (WeightPreq7[Domain] <> preNA) and
3839 (RW[Player].Tech[WeightPreq7[Domain]] >= tsApplicable) then
3840 MaxWeight := 7;
3841 if (WeightPreq10[Domain] <> preNA) and
3842 (RW[Player].Tech[WeightPreq10[Domain]] >= tsApplicable) then
3843 if Domain = dSea then
3844 MaxWeight := 9
3845 else
3846 MaxWeight := 10;
3847 end;
3848 CalculateModel(RW[Player].DevModel);
3849 DevModelTurn[Player] := GTurn;
3850 end
3851 end;
3852
3853 sSetDevModelCap .. sSetDevModelCap + $3F0,
3854 sSetDevModelCap - sExecute .. sSetDevModelCap - sExecute + $3F0:
3855 begin
3856{$IFDEF TEXTLOG}CmdInfo := Format('SetDevModelCap P%d', [Player]); {$ENDIF}
3857 if Subject >= nFeature then
3858 result := eInvalid
3859 else if DevModelTurn[Player] = GTurn then
3860 begin
3861 NewCap := Command shr 4 and $3F; { new value }
3862 with RW[Player].DevModel do
3863 if 1 shl Domain and Feature[Subject].Domains = 0 then
3864 result := eDomainMismatch
3865 else if not((Feature[Subject].Preq = preNone) or
3866 (Feature[Subject].Preq = preSun) and
3867 (GWonder[woSun].EffectiveOwner = Player) or
3868 (Feature[Subject].Preq >= 0) and
3869 (RW[Player].Tech[Feature[Subject].Preq] >= tsApplicable)) then
3870 result := eNoPreq
3871 else
3872 begin
3873 if (Subject in AutoFeature) or (Subject = mcDefense) then
3874 MinCap := 1
3875 else
3876 MinCap := 0; { MinCap - minimum use of feature }
3877 if Subject >= mcFirstNonCap then
3878 MaxCap := 1
3879 else if Subject = mcDefense then
3880 begin
3881 if Domain = dGround then
3882 MaxCap := 2
3883 else
3884 MaxCap := 3;
3885 if RW[Player].Tech[adSteel] >= tsApplicable then
3886 inc(MaxCap)
3887 end
3888 else
3889 MaxCap := 8; { MaxCap - maximum use of this feature }
3890 if (Domain = dGround) and (Subject = mcDefense) then
3891 CapWeight := 2
3892 else
3893 CapWeight := Feature[Subject].Weight;
3894 if (NewCap < MinCap) or (NewCap > MaxCap) or
3895 (Weight + (NewCap - Cap[Subject]) * CapWeight > MaxWeight) then
3896 result := eViolation
3897 else if Command >= sExecute then
3898 begin
3899 Cap[Subject] := NewCap;
3900
3901 // mutual feature exclusion
3902 case Subject of
3903 mcSub:
3904 begin
3905 if ServerVersion[Player] >= $010103 then
3906 Cap[mcSeaTrans] := 0;
3907 Cap[mcArtillery] := 0;
3908 Cap[mcCarrier] := 0;
3909 if Cap[mcDefense] > 2 then
3910 Cap[mcDefense] := 2
3911 end;
3912 mcSeaTrans:
3913 begin
3914 if ServerVersion[Player] >= $010103 then
3915 Cap[mcSub] := 0;
3916 end;
3917 mcCarrier:
3918 Cap[mcSub] := 0;
3919 mcArtillery:
3920 Cap[mcSub] := 0;
3921 mcAlpine:
3922 begin
3923 Cap[mcOver] := 0;
3924 Cap[mcMob] := 0;
3925 end;
3926 mcOver:
3927 Cap[mcAlpine] := 0;
3928 mcMob:
3929 begin
3930 Cap[mcAlpine] := 0;
3931 end;
3932 end;
3933
3934 CalculateModel(RW[Player].DevModel);
3935 end
3936 end;
3937 end
3938 else
3939 result := eNoModel;
3940 end;
3941
3942 {
3943 Unit Related Commands
3944 ____________________________________________________________________
3945 }
3946 sRemoveUnit, sRemoveUnit - sExecute:
3947 begin
3948{$IFDEF TEXTLOG}CmdInfo := Format('RemoveUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
3949 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
3950 result := eInvalid
3951 else
3952 begin
3953 result := eRemoved;
3954 Loc0 := RW[Player].Un[Subject].Loc;
3955 if RealMap[Loc0] and fCity <> 0 then { check utilize }
3956 begin
3957 SearchCity(Loc0, Player, cix1);
3958 with RW[Player].City[cix1] do
3959 begin
3960 if (RW[Player].Model[RW[Player].Un[Subject].mix].Kind = mkCaravan)
3961 and ((Project and cpImp = 0) or
3962 (Imp[Project and cpIndex].Kind <> ikShipPart)) or
3963 (Project and cpImp = 0) and
3964 (RW[Player].Model[Project and cpIndex].Kind <> mkCaravan) then
3965 result := eUtilized;
3966 if Command >= sExecute then
3967 begin
3968 if result = eUtilized then
3969 begin
3970 with RW[Player].Un[Subject] do
3971 begin
3972 Cost := integer(RW[Player].Model[mix].Cost) * Health *
3973 BuildCostMod[Difficulty[Player]] div 1200;
3974 if RW[Player].Model[mix].Cap[mcLine] > 0 then
3975 Cost := Cost div 2;
3976 end;
3977 if Project and (cpImp + cpIndex) = cpImp + imTrGoods then
3978 inc(RW[Player].Money, Cost)
3979 else
3980 begin
3981 inc(Prod, Cost * 2 div 3);
3982 Project0 := Project0 and not cpCompleted;
3983 if Project0 and not cpAuto <> Project and not cpAuto then
3984 Project0 := Project;
3985 Prod0 := Prod;
3986 end
3987 end;
3988 RemoveUnit_UpdateMap(Player, Subject);
3989 end;
3990 end;
3991 end
3992 else if Command >= sExecute then
3993 RemoveUnit_UpdateMap(Player, Subject);
3994 end
3995 end;
3996
3997 sSetUnitHome, sSetUnitHome - sExecute:
3998 begin
3999{$IFDEF TEXTLOG}CmdInfo := Format('SetUnitHome P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
4000 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4001 result := eInvalid
4002 else
4003 begin
4004 Loc0 := RW[Player].Un[Subject].Loc;
4005 if RealMap[Loc0] and fCity = 0 then
4006 result := eInvalid
4007 else
4008 begin
4009 SearchCity(Loc0, Player, cix1);
4010 if RW[Player].City[cix1].Flags and chCaptured <> 0 then
4011 result := eViolation
4012 else if Command >= sExecute then
4013 RW[Player].Un[Subject].Home := cix1
4014 end
4015 end
4016 end;
4017
4018 sSetSpyMission .. sSetSpyMission + (nSpyMission - 1) shl 4,
4019 sSetSpyMission - sExecute .. sSetSpyMission - sExecute +
4020 (nSpyMission - 1) shl 4:
4021 if Command >= sExecute then
4022 SpyMission := Command shr 4 and $F;
4023
4024 sLoadUnit, sLoadUnit - sExecute:
4025 begin
4026{$IFDEF TEXTLOG}CmdInfo := Format('LoadUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
4027 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4028 result := eInvalid
4029 else
4030 result := LoadUnit(Player, Subject, Command < sExecute);
4031 end;
4032
4033 sUnloadUnit, sUnloadUnit - sExecute:
4034 begin
4035{$IFDEF TEXTLOG}CmdInfo := Format('UnloadUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
4036 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4037 result := eInvalid
4038 else
4039 result := UnloadUnit(Player, Subject, Command < sExecute)
4040 end;
4041
4042 sSelectTransport, sSelectTransport - sExecute:
4043 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4044 result := eInvalid
4045 else
4046 with RW[Player].Model[RW[Player].Un[Subject].mix] do
4047 begin
4048 if Cap[mcSeaTrans] + Cap[mcAirTrans] + Cap[mcCarrier] = 0 then
4049 result := eInvalid
4050 else if Command >= sExecute then
4051 uixSelectedTransport := Subject;
4052 end;
4053
4054 sCreateUnit .. sCreateUnit + (nPl - 1) shl 4,
4055 sCreateUnit - sExecute .. sCreateUnit - sExecute + (nPl - 1) shl 4:
4056 if (GTestFlags and tfUncover <> 0) or (Difficulty[Player] = 0)
4057 then { supervisor only command }
4058 begin
4059 p1 := Command shr 4 and $F;
4060 Loc1 := integer(Data);
4061 if (Occupant[Loc1] >= 0) and (p1 <> Occupant[Loc1]) or
4062 (RealMap[Loc1] and fCity <> 0) and
4063 (RealMap[Loc1] shr 27 <> Cardinal(p1)) or
4064 (RW[p1].Model[Subject].Domain < dAir) and
4065 ((RW[p1].Model[Subject].Domain = dSea) <> (RealMap[integer(Data)] and
4066 fTerrain < fGrass)) then
4067 result := eViolation
4068 else if Command >= sExecute then
4069 begin
4070 CreateUnit(p1, Subject);
4071 RW[p1].Un[RW[p1].nUn - 1].Loc := integer(Data);
4072 PlaceUnit(p1, RW[p1].nUn - 1);
4073 UpdateUnitMap(integer(Data));
4074 end
4075 end
4076 else
4077 result := eInvalid;
4078
4079 sMoveUnit + (0 + 6 * 8) * 16, sMoveUnit + (1 + 7 * 8) * 16,
4080 sMoveUnit + (2 + 0 * 8) * 16, sMoveUnit + (1 + 1 * 8) * 16,
4081 sMoveUnit + (0 + 2 * 8) * 16, sMoveUnit + (7 + 1 * 8) * 16,
4082 sMoveUnit + (6 + 0 * 8) * 16, sMoveUnit + (7 + 7 * 8) * 16,
4083 sMoveUnit - sExecute + (0 + 6 * 8) * 16, sMoveUnit - sExecute +
4084 (1 + 7 * 8) * 16, sMoveUnit - sExecute + (2 + 0 * 8) * 16,
4085 sMoveUnit - sExecute + (1 + 1 * 8) * 16, sMoveUnit - sExecute +
4086 (0 + 2 * 8) * 16, sMoveUnit - sExecute + (7 + 1 * 8) * 16,
4087 sMoveUnit - sExecute + (6 + 0 * 8) * 16, sMoveUnit - sExecute +
4088 (7 + 7 * 8) * 16:
4089 begin
4090 dx := (Command shr 4 + 4) and 7 - 4;
4091 dy := (Command shr 7 + 4) and 7 - 4;
4092{$IFDEF TEXTLOG}CmdInfo := Format('MoveUnit P%d I%d Mod%d Loc%d (%d,%d)', [Player, Subject, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc, dx, dy]); {$ENDIF}
4093 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4094 result := eInvalid
4095 else
4096 result := MoveUnit(Player, Subject, dx, dy, Command < sExecute);
4097 end;
4098
4099 {
4100 Settlers Related Commands
4101 ____________________________________________________________________
4102 }
4103 sAddToCity, sAddToCity - sExecute:
4104 begin
4105{$IFDEF TEXTLOG}CmdInfo := Format('AddToCity P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
4106 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4107 result := eInvalid
4108 else if not(RW[Player].Model[RW[Player].Un[Subject].mix].Kind
4109 in [mkSettler, mkSlaves]) and
4110 (RW[Player].Un[Subject].Flags and unConscripts = 0) then
4111 result := eViolation
4112 else
4113 begin
4114 Loc0 := RW[Player].Un[Subject].Loc;
4115 if RealMap[Loc0] and fCity = 0 then
4116 result := eInvalid
4117 else
4118 begin
4119 SearchCity(Loc0, Player, cix1);
4120 with RW[Player].City[cix1] do
4121 if not CanCityGrow(Player, cix1) then
4122 result := eMaxSize
4123 else if Command >= sExecute then
4124 begin { add to city }
4125 if Mode = moPlaying then
4126 SavedTiles[cix1] := 0; // save in every case
4127 if CanCityGrow(Player, cix1) then
4128 CityGrowth(Player, cix1);
4129 if (RW[Player].Model[RW[Player].Un[Subject].mix]
4130 .Kind = mkSettler) and CanCityGrow(Player, cix1) then
4131 CityGrowth(Player, cix1);
4132 RemoveUnit_UpdateMap(Player, Subject);
4133 end
4134 end
4135 end
4136 end;
4137
4138 sStartJob .. sStartJob + $3F0, sStartJob - sExecute .. sStartJob + $3F0
4139 - sExecute:
4140 begin
4141 Loc0 := RW[Player].Un[Subject].Loc;
4142 i := Command shr 4 and $3F; // new job
4143{$IFDEF TEXTLOG}CmdInfo := Format('StartJob P%d Mod%d Loc%d: %d', [Player, RW[Player].Un[Subject].mix, Loc0, i]); {$ENDIF}
4144 if (Subject >= RW[Player].nUn) or (Loc0 < 0) then
4145 result := eInvalid
4146 else if i >= nJob then
4147 result := eInvalid
4148 else
4149 begin
4150 result := StartJob(Player, Subject, i, Command < sExecute);
4151 if result = eCity then
4152 begin // new city
4153 cix1 := RW[Player].nCity - 1;
4154 AddBestCityTile(Player, cix1);
4155 if Mode = moPlaying then
4156 with RW[Player].City[cix1] do
4157 begin
4158 // SavedResourceWeights[cix1]:=ResourceWeights;
4159 SavedTiles[cix1] := 0; // save in every case
4160 end;
4161 if Mode >= moMovie then { show new city in interface modules }
4162 for p1 := 0 to nPl - 1 do
4163 if (1 shl p1 and GWatching <> 0) and (p1 <> Player) and
4164 (ObserveLevel[Loc0] and (3 shl (2 * p1)) > 0) then
4165 CallPlayer(cShowCityChanged, p1, Loc0);
4166 end
4167 end;
4168 end;
4169
4170 {
4171 City Related Commands
4172 ____________________________________________________________________
4173 }
4174 sSetCityProject, sSetCityProject - sExecute:
4175 begin
4176 NewProject := integer(Data) and not cpAuto;
4177{$IFDEF TEXTLOG}CmdInfo := Format('SetCityProject P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, NewProject]); {$ENDIF}
4178 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4179 then
4180 result := eInvalid
4181 else
4182 with RW[Player].City[Subject] do
4183 begin
4184 if NewProject = Project then
4185 result := eNotChanged
4186 else
4187 begin
4188 pt0 := ProjectType(Project0);
4189 pt1 := ProjectType(NewProject);
4190 if NewProject and cpImp = 0 then
4191 begin
4192 if NewProject and cpIndex >= RW[Player].nModel then
4193 result := eInvalid
4194 else if (NewProject and cpConscripts <> 0) and
4195 not((RW[Player].Tech[adConscription] >= tsApplicable) and
4196 (RW[Player].Model[NewProject and cpIndex].Domain = dGround)
4197 and (RW[Player].Model[NewProject and cpIndex].Kind < mkScout))
4198 then
4199 result := eViolation
4200 // else if (RW[Player].Model[NewProject and cpIndex].Kind=mkSlaves)
4201 // and (GWonder[woPyramids].EffectiveOwner<>Player) then
4202 // result:=eNoPreq
4203 end
4204 else if NewProject and cpIndex >= nImp then
4205 result := eInvalid
4206 else
4207 begin
4208 Preq := Imp[NewProject and cpIndex].Preq;
4209 for i := 0 to nImpReplacement - 1 do
4210 if (ImpReplacement[i].OldImp = NewProject and cpIndex) and
4211 (built[ImpReplacement[i].NewImp] > 0) then
4212 result := eObsolete;
4213 if result = eObsolete then
4214 else if Preq = preNA then
4215 result := eInvalid
4216 else if (Preq >= 0) and (RW[Player].Tech[Preq] < tsApplicable)
4217 then
4218 result := eNoPreq
4219 else if built[NewProject and cpIndex] > 0 then
4220 result := eInvalid
4221 else if (NewProject and cpIndex < 28) and
4222 (GWonder[NewProject and cpIndex].CityID <> -1) then
4223 result := eViolation // wonder already exists
4224 else if (NewProject and cpIndex = imSpacePort) and
4225 (RW[Player].NatBuilt[imSpacePort] > 0) then
4226 result := eViolation // space port already exists
4227 else if (NewProject = cpImp + imBank) and (built[imMarket] = 0)
4228 or (NewProject = cpImp + imUniversity) and
4229 (built[imLibrary] = 0) or (NewProject = cpImp + imResLab) and
4230 (built[imUniversity] = 0) or (NewProject = cpImp + imMfgPlant)
4231 and (built[imFactory] = 0) then
4232 result := eNoPreq;
4233 case NewProject - cpImp of
4234 woLighthouse, woMagellan, imCoastalFort, imHarbor, imPlatform:
4235 begin { city at ocean? }
4236 Preq := 0;
4237 V8_to_Loc(Loc, Adjacent);
4238 for V8 := 0 to 7 do
4239 begin
4240 Loc1 := Adjacent[V8];
4241 if (Loc1 >= 0) and (Loc1 < MapSize) and
4242 (RealMap[Loc1] and fTerrain = fShore) then
4243 inc(Preq);
4244 end;
4245 if Preq = 0 then
4246 result := eNoPreq;
4247 end;
4248 woHoover, imHydro:
4249 begin { city at river or mountains? }
4250 Preq := 0;
4251 V8_to_Loc(Loc, Adjacent);
4252 for V8 := 0 to 7 do
4253 begin
4254 Loc1 := Adjacent[V8];
4255 if (Loc1 >= 0) and (Loc1 < MapSize) and
4256 ((RealMap[Loc1] and fTerrain = fMountains) or
4257 (RealMap[Loc1] and fRiver <> 0)) then
4258 inc(Preq);
4259 end;
4260 if Preq = 0 then
4261 result := eNoPreq;
4262 end;
4263 woMIR, imShipComp, imShipPow, imShipHab:
4264 if RW[Player].NatBuilt[imSpacePort] = 0 then
4265 result := eNoPreq;
4266 end;
4267 if (GTestFlags and tfNoRareNeed = 0) and
4268 (Imp[NewProject and cpIndex].Kind = ikShipPart) then
4269 if RW[Player].Tech[adMassProduction] < tsApplicable then
4270 result := eNoPreq
4271 else
4272 begin // check for rare resources
4273 if NewProject and cpIndex = imShipComp then
4274 j := 1
4275 else if NewProject and cpIndex = imShipPow then
4276 j := 2
4277 else { if NewProject and cpIndex=imShipHab then }
4278 j := 3;
4279 // j = rare resource required
4280 Preq := 0;
4281 V21_to_Loc(Loc, Radius);
4282 for V21 := 1 to 26 do
4283 begin
4284 Loc1 := Radius[V21];
4285 if (Loc1 >= 0) and (Loc1 < MapSize) and
4286 (RealMap[Loc1] shr 25 and 3 = Cardinal(j)) then
4287 inc(Preq);
4288 end;
4289 if Preq = 0 then
4290 result := eNoPreq;
4291 end
4292 end;
4293
4294 if (Command >= sExecute) and (result >= rExecuted) then
4295 begin
4296 if pt0 <> ptSelect then
4297 if NewProject and (cpImp or cpIndex) = Project0 and
4298 (cpImp or cpIndex) then
4299 Prod := Prod0
4300 else if (pt1 = ptTrGoods) or (pt1 = ptShip) or (pt1 <> pt0)
4301 and (pt0 <> ptCaravan) then
4302 begin
4303 inc(RW[Player].Money, Prod0);
4304 Prod := 0;
4305 Prod0 := 0;
4306 Project0 := cpImp + imTrGoods
4307 end
4308 else
4309 Prod := Prod0 * 2 div 3;
4310 Project := NewProject
4311 end
4312 end
4313 end
4314 end;
4315
4316 sBuyCityProject, sBuyCityProject - sExecute:
4317 begin
4318{$IFDEF TEXTLOG}CmdInfo := Format('BuyCityProject P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF}
4319 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4320 then
4321 result := eInvalid
4322 else
4323 with RW[Player].City[Subject] do
4324 if (RW[Player].Government = gAnarchy) or (Flags and chCaptured <> 0)
4325 then
4326 result := eOutOfControl
4327 else if (Project and cpImp <> 0) and
4328 ((Project and cpIndex = imTrGoods) or
4329 (Imp[Project and cpIndex].Kind = ikShipPart)) then
4330 result := eInvalid // don't buy colony ship
4331 else
4332 begin
4333 CityReport.HypoTiles := -1;
4334 CityReport.HypoTax := -1;
4335 CityReport.HypoLux := -1;
4336 GetCityReport(Player, Subject, CityReport);
4337 Cost := CityReport.ProdCost;
4338 NextProd := CityReport.ProdRep - CityReport.Support;
4339 if (CityReport.Working - CityReport.Happy > Size shr 1) or
4340 (NextProd < 0) then // !!! change to new style disorder
4341 NextProd := 0;
4342 Cost := Cost - Prod - NextProd;
4343 if (GWonder[woMich].EffectiveOwner = Player) and
4344 (Project and cpImp <> 0) then
4345 Cost := Cost * 2
4346 else
4347 Cost := Cost * 4;
4348 if Cost <= 0 then
4349 result := eNotChanged
4350 else if Cost > RW[Player].Money then
4351 result := eViolation
4352 else if Command >= sExecute then
4353 IntServer(sIntBuyMaterial, Player, Subject, Cost);
4354 // need to save material/cost because city tiles are not correct
4355 // when loading
4356 end;
4357 end;
4358
4359 sSellCityProject, sSellCityProject - sExecute:
4360 begin
4361{$IFDEF TEXTLOG}CmdInfo := Format('SellCityProject P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF}
4362 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4363 then
4364 result := eInvalid
4365 else if Command >= sExecute then
4366 with RW[Player].City[Subject] do
4367 begin
4368 inc(RW[Player].Money, Prod0);
4369 Prod := 0;
4370 Prod0 := 0;
4371 end;
4372 end;
4373
4374 sSellCityImprovement, sSellCityImprovement - sExecute:
4375 begin
4376{$IFDEF TEXTLOG}CmdInfo := Format('SellCityImprovement P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, integer(Data)]); {$ENDIF}
4377 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4378 then
4379 result := eInvalid
4380 else
4381 with RW[Player].City[Subject] do
4382 if built[integer(Data)] = 0 then
4383 result := eInvalid
4384 else if (RW[Player].Government = gAnarchy) or
4385 (Flags and chCaptured <> 0) then
4386 result := eOutOfControl
4387 else if Flags and chImprovementSold <> 0 then
4388 result := eOnlyOnce
4389 else if Command >= sExecute then
4390 begin
4391 inc(RW[Player].Money, Imp[integer(Data)].Cost * BuildCostMod
4392 [Difficulty[Player]] div 12);
4393 built[integer(Data)] := 0;
4394 if Imp[integer(Data)].Kind in [ikNatLocal, ikNatGlobal] then
4395 begin
4396 RW[Player].NatBuilt[integer(Data)] := 0;
4397 case integer(Data) of
4398 imGrWall:
4399 GrWallContinent[Player] := -1;
4400 imSpacePort:
4401 DestroySpacePort_TellPlayers(Player, -1);
4402 end
4403 end;
4404 inc(Flags, chImprovementSold);
4405 end
4406 end;
4407
4408 sRebuildCityImprovement, sRebuildCityImprovement - sExecute:
4409 begin
4410 OldImp := integer(Data);
4411{$IFDEF TEXTLOG}CmdInfo := Format('RebuildCityImprovement P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, OldImp]); {$ENDIF}
4412 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4413 then
4414 result := eInvalid
4415 else
4416 begin
4417 if (OldImp < 0) or (OldImp >= nImp) or
4418 not(Imp[OldImp].Kind in [ikCommon, ikNatLocal, ikNatGlobal]) then
4419 result := eInvalid
4420 else
4421 with RW[Player].City[Subject] do
4422 if (built[OldImp] = 0) or (Project and cpImp = 0) or
4423 not(Imp[Project and cpIndex].Kind in [ikCommon, ikNatLocal,
4424 ikNatGlobal]) then
4425 result := eInvalid
4426 else if (RW[Player].Government = gAnarchy) or
4427 (Flags and chCaptured <> 0) then
4428 result := eOutOfControl
4429 else if Flags and chImprovementSold <> 0 then
4430 result := eOnlyOnce
4431 else if Command >= sExecute then
4432 begin
4433 inc(Prod, Imp[OldImp].Cost * BuildCostMod[Difficulty[Player]]
4434 div 12 * 2 div 3);
4435 Project0 := Project0 and not cpCompleted;
4436 if Project0 and not cpAuto <> Project and not cpAuto then
4437 Project0 := Project;
4438 Prod0 := Prod;
4439 built[OldImp] := 0;
4440 if Imp[OldImp].Kind in [ikNatLocal, ikNatGlobal] then
4441 begin // nat. project lost
4442 RW[Player].NatBuilt[OldImp] := 0;
4443 case OldImp of
4444 imGrWall:
4445 GrWallContinent[Player] := -1;
4446 imSpacePort:
4447 DestroySpacePort_TellPlayers(Player, -1);
4448 end
4449 end;
4450 inc(Flags, chImprovementSold);
4451 end
4452 end
4453 end;
4454
4455 sSetCityTiles, sSetCityTiles - sExecute:
4456 begin
4457{$IFDEF TEXTLOG}CmdInfo := Format('SetCityTiles P%d Loc%d: %x', [Player, RW[Player].City[Subject].Loc, integer(Data)]); {$ENDIF}
4458 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4459 then
4460 result := eInvalid
4461 else
4462 result := SetCityTiles(Player, Subject, integer(Data),
4463 Command < sExecute);
4464 end;
4465
4466 {
4467 Client Exclusive Commands
4468 ____________________________________________________________________
4469 }
4470 else
4471 if Command >= cClientEx then
4472 begin
4473{$IFDEF TEXTLOG}CmdInfo := Format('ClientEx%x P%d', [Command, Player]);
4474 {$ENDIF}
4475 if ProcessClientData[Player] or (Mode = moPlaying) then
4476 CallPlayer(Command, Player, Data)
4477 end
4478 else
4479 result := eUnknown;
4480 end; { case command }
4481
4482 // do not log invalid and non-relevant commands
4483 if result = eZOC_EnemySpotted then
4484 begin
4485 assert(Mode = moPlaying);
4486 CL.State := FormerCLState;
4487 IntServer(sIntDiscoverZOC, Player, 0, ZOCTile);
4488 end
4489 else if result and rEffective = 0 then
4490 if Mode < moPlaying then
4491 begin
4492{$IFDEF TEXTLOG}CmdInfo := Format('***ERROR (%x) ', [result]) + CmdInfo;
4493 {$ENDIF}
4494 LoadOK := false;
4495 end
4496 else
4497 begin
4498 if logged then
4499 CL.State := FormerCLState;
4500 if (result < rExecuted) and (Command >= sExecute) then
4501 PutMessage(1 shl 16 + 1, Format('INVALID: %d calls %x (%d)',
4502 [Player, Command, Subject]));
4503 end;
4504
4505 if (Command and (cClientEx or sExecute or sctMask) = sExecute or sctEndClient)
4506 and (result >= rExecuted) then
4507 LastEndClientCommand := Command;
4508{$IFOPT O-}dec(nHandoverStack, 2); {$ENDIF}
4509end; { <<<server }
4510
4511{ TBrain }
4512
4513procedure TBrain.LoadFromFile(AIFileName: string);
4514var
4515 T: Text;
4516 Key: string;
4517 Value: string;
4518 S: string;
4519 BasePath: string;
4520 I: Integer;
4521begin
4522 BasePath := ExtractFileDir(AIFileName);
4523 FileName := ExtractFileName(ExtractFileNameWithoutExt(ExtractFileNameWithoutExt(AIFileName)));
4524 Name := FileName;
4525 DLLName := BasePath + DirectorySeparator + Name + '.dll';
4526 Credits := '';
4527 Flags := fMultiple;
4528 Client := nil;
4529 Initialized := false;
4530 ServerVersion := 0;
4531 if not FileExists(AIFileName) then
4532 raise Exception.Create(Format('AI specification file %s not found', [AIFileName]));
4533 AssignFile(T, AIFileName);
4534 Reset(T);
4535 while not EOF(T) do
4536 begin
4537 ReadLn(T, s);
4538 s := trim(s);
4539 if Pos(' ', S) > 0 then begin
4540 Key := Copy(S, 1, Pos(' ', S) - 1);
4541 Value := Trim(Copy(S, Pos(' ', S) + 1, Length(S)));
4542 end else begin
4543 Key := S;
4544 Value := '';
4545 end;
4546 if Key = '#NAME' then
4547 Name := Value
4548 else if Key = '#.NET' then
4549 Flags := Flags or fDotNet
4550 else if Key = '#BEGINNER' then
4551 BrainBeginner := Self
4552 else if Key = '#PATH' then
4553 DLLName := BasePath + DirectorySeparator + Value
4554 {$IFDEF WINDOWS}{$IFDEF CPU32}
4555 else if Key = '#PATH_WIN32' then
4556 DLLName := BasePath + DirectorySeparator + Value
4557 {$ENDIF}{$ENDIF}
4558 {$IFDEF WINDOWS}{$IFDEF CPU64}
4559 else if Key = '#PATH_WIN64' then
4560 DLLName := BasePath + DirectorySeparator + Value
4561 {$ENDIF}{$ENDIF}
4562 {$IFDEF LINUX}{$IFDEF CPU32}
4563 else if Key = '#PATH_LINUX32' then
4564 DLLName := BasePath + DirectorySeparator + Value
4565 {$ENDIF}{$ENDIF}
4566 {$IFDEF LINUX}{$IFDEF CPU64}
4567 else if Key = '#PATH_LINUX64' then
4568 DLLName := BasePath + DirectorySeparator + Value
4569 {$ENDIF}{$ENDIF}
4570 else if Key = '#GAMEVERSION' then
4571 for i := 1 to Length(Value) do
4572 case Value[i] of
4573 '0' .. '9':
4574 ServerVersion := ServerVersion and $FFFF00 + ServerVersion and
4575 $FF * 10 + ord(Value[i]) - 48;
4576 '.':
4577 ServerVersion := ServerVersion shl 8;
4578 end
4579 else if Key = '#CREDITS' then
4580 Credits := Value;
4581 end;
4582 CloseFile(T);
4583end;
4584
4585constructor TBrain.Create;
4586begin
4587 Picture := nil;
4588end;
4589
4590destructor TBrain.Destroy;
4591begin
4592 if Assigned(Picture) then Picture.Free;
4593 inherited Destroy;
4594end;
4595
4596{ TBrains }
4597
4598function TBrains.AddNew: TBrain;
4599begin
4600 Result := TBrain.Create;
4601 Add(Result);
4602end;
4603
4604function TBrains.GetKindCount(Kind: TBrainType): Integer;
4605var
4606 I: Integer;
4607begin
4608 Result := 0;
4609 for I := 0 to Count - 1 do
4610 if Items[I].Kind = Kind then Inc(Result);
4611end;
4612
4613procedure TBrains.GetByKind(Kind: TBrainType; Brains: TBrains);
4614var
4615 I: Integer;
4616begin
4617 Brains.Clear;
4618 for I := 0 to Count - 1 do
4619 if Items[I].Kind = Kind then Brains.Add(Items[I]);
4620end;
4621
4622initialization
4623
4624FindFirst(ParamStr(0), $21, ExeInfo);
4625FindClose(ExeInfo);
4626
4627{$IFOPT O-}nHandoverStack := 0; {$ENDIF}
4628
4629end.
Note: See TracBrowser for help on using the repository browser.