source: trunk/GameServer.pas@ 183

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