source: trunk/GameServer.pas@ 328

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